diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index c4bd543bfd..b429da649b 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -789,9 +789,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, call mpp_get_layout(input_domain,layout) call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) if (PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) endif call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) @@ -1059,40 +1059,40 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) - case('area') - array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) - case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) + case('area') + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + case('mask') + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result ! do j=g_jsc,g_jec ; do i=g_isc,g_iec ! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) ! enddo ; enddo - case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('btfHeat') - array2D(isc:,jsc:) = 0 - case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 - case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 - case('s_surf') - array2D(isc:,jsc:) = Ocean%s_surf(isc:,jsc:) - case('sea_lev') - array2D(isc:,jsc:) = Ocean%sea_lev(isc:,jsc:) - case('frazil') - array2D(isc:,jsc:) = Ocean%frazil(isc:,jsc:) - case('melt_pot') - array2D(isc:,jsc:) = Ocean%melt_potential(isc:,jsc:) - case('obld') - array2D(isc:,jsc:) = Ocean%OBLD(isc:,jsc:) - case default - call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) + case('t_surf') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_pme') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_runoff') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_calving') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('btfHeat') + array2D(isc:,jsc:) = 0 + case('cos_rot') + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + case('sin_rot') + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + case('s_surf') + array2D(isc:,jsc:) = Ocean%s_surf(isc:,jsc:) + case('sea_lev') + array2D(isc:,jsc:) = Ocean%sea_lev(isc:,jsc:) + case('frazil') + array2D(isc:,jsc:) = Ocean%frazil(isc:,jsc:) + case('melt_pot') + array2D(isc:,jsc:) = Ocean%melt_potential(isc:,jsc:) + case('obld') + array2D(isc:,jsc:) = Ocean%OBLD(isc:,jsc:) + case default + call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select end subroutine ocean_model_data2D_get @@ -1209,7 +1209,7 @@ subroutine ocean_model_get_UV_surf(OS, Ocean, name, array2D, isc, jsc) 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) enddo ; enddo case default - call MOM_error(FATAL,'ocean_model_get_UV_surf: unknown argument name='//name) + call MOM_error(FATAL,'ocean_model_get_UV_surf: unknown argument name='//name) end select end subroutine ocean_model_get_UV_surf diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index e2f0694b6c..679f147797 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -274,7 +274,7 @@ subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) - endif + endif end subroutine MESO_surface_forcing_init diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 3d8b398516..6ace2e05c2 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -1240,7 +1240,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US ! note the sign convention do j=js,je ; do i=is,ie - fluxes%sens(i,j) = -US%W_m2_to_QRZ_T * fluxes%sens(i,j) ! Normal convention is positive into the ocean + fluxes%sens(i,j) = -US%W_m2_to_QRZ_T * fluxes%sens(i,j) ! Normal convention is positive into the ocean ! but sensible is normally a positive quantity in the files enddo ; enddo @@ -1271,11 +1271,11 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US ! Read the SST and SSS fields for damping. if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then - call data_override('OCN', 'SST_restore', CS%T_restore(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + call data_override('OCN', 'SST_restore', CS%T_restore(:,:), day, & + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - call data_override('OCN', 'SSS_restore', CS%S_restore(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + call data_override('OCN', 'SSS_restore', CS%S_restore(:,:), day, & + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) endif diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index f5372e07d2..d8f008e9ef 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -89,7 +89,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt((CS%gust_const + & + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt((CS%gust_const + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))) * (US%L_to_Z/CS%Rho0)) enddo ; enddo ; endif diff --git a/config_src/unit_drivers/MOM_sum_driver.F90 b/config_src/unit_drivers/MOM_sum_driver.F90 index 5673b201ee..7e3c6d45b4 100644 --- a/config_src/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/unit_drivers/MOM_sum_driver.F90 @@ -18,8 +18,6 @@ program MOM_main use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_to_real, real_to_EFP use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT -! use MOM_diag_mediator, only : diag_mediator_end, diag_mediator_init -! use MOM_diag_mediator, only : diag_mediator_close_registration use MOM_domains, only : MOM_domains_init, MOM_infra_init, MOM_infra_end use MOM_error_handler, only : MOM_error, MOM_mesg, WARNING, FATAL, is_root_pe use MOM_error_handler, only : MOM_set_verbosity @@ -39,11 +37,10 @@ program MOM_main type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. - real :: max_depth + real :: max_depth ! The maximum ocean depth [m] integer :: verbosity integer :: num_sums - integer :: n, i, j, is, ie, js, je, nz - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + integer :: n, i, j, is, ie, js, je, isd, ied, jsd, jed integer :: unit, io_status, ierr logical :: unit_in_use @@ -55,8 +52,8 @@ program MOM_main !----------------------------------------------------------------------- character(len=4), parameter :: vers_num = 'v2.0' -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_main (MOM_sum_driver)" ! This module's name. character(len=200) :: mesg @@ -85,9 +82,8 @@ program MOM_main ! call diag_mediator_init(param_file) call MOM_grid_init(grid, param_file) - is = grid%isc ; ie = grid%iec ; js = grid%jsc ; je = grid%jec ; nz = grid%ke + is = grid%isc ; ie = grid%iec ; js = grid%jsc ; je = grid%jec isd = grid%isd ; ied = grid%ied ; jsd = grid%jsd ; jed = grid%jed - IsdB = grid%IsdB ; IedB = grid%IedB ; JsdB = grid%JsdB ; JedB = grid%JedB ! Read all relevant parameters and write them to the model log. call log_version(param_file, "MOM", version, "") @@ -165,27 +161,25 @@ program MOM_main contains +!> This subroutine sets up the benchmark test case topography for debugging subroutine benchmark_init_topog_local(D, G, param_file, max_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(out) :: D !< The ocean bottom depth in m type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - real, intent(in) :: max_depth !< The maximum ocean depth in m + real, intent(in) :: max_depth !< The maximum ocean depth [m] -! This subroutine sets up the benchmark test case topography real :: min_depth ! The minimum ocean depth in m. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! real :: x, y -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "benchmark_initialize_topography" ! This subroutine's name. + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "benchmark_init_topog_local" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_topography: setting topography", 5) - call log_version(param_file, mdl, version) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 156a30b2d7..fe1563232f 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -364,9 +364,9 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) ! Build new grid. The new grid is stored in h_new. The old grid is h. ! Both are needed for the subsequent remapping of variables. if (ice_shelf) then - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h) + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h) else - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid) + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid) endif call check_grid( G, GV, h, 0. ) @@ -480,7 +480,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 @@ -523,7 +523,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 @@ -633,9 +633,9 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h ! Build new grid. The new grid is stored in h_new. The old grid is h. ! Both are needed for the subsequent remapping of variables. if (use_ice_shelf) then - call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h ) + call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h ) else - call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid ) + call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid ) endif ! Override old grid with new one. The new grid 'h_new' is built in diff --git a/src/ALE/PLM_functions.F90 b/src/ALE/PLM_functions.F90 index da60f9614a..d0f620e4a8 100644 --- a/src/ALE/PLM_functions.F90 +++ b/src/ALE/PLM_functions.F90 @@ -168,8 +168,8 @@ real elemental pure function PLM_extrapolate_slope(h_l, h_c, h_neglect, u_l, u_c real :: hl, hc ! Left and central cell thicknesses [units of grid thickness] ! Avoid division by zero for vanished cells - hl = h_l + h_neglect - hc = h_c + h_neglect + hl = h_l + h_neglect + hc = h_c + h_neglect ! The h2 scheme is used to compute the left edge value left_edge = (u_l*hc + u_c*hl) / (hl + hc) diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 1ab225474c..0c758fadaf 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -76,7 +76,7 @@ module regrid_interp !! a third-order PPM ih4 scheme). In these cases, we resort to the simplest !! continuous linear scheme (P1M h2). subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & - ppoly0_coefs, degree, h_neglect, h_neglect_edge) + ppoly0_coefs, degree, h_neglect, h_neglect_edge) type(interp_CS_type), intent(in) :: CS !< Interpolation control structure integer, intent(in) :: n0 !< Number of cells on source grid real, dimension(n0), intent(in) :: densities !< Actual cell densities [A] diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fa7c3ca565..f11ce42407 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -506,7 +506,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 @@ -984,7 +984,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 @@ -1135,7 +1135,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thicknesses after the transports [H ~> m or kg m-2] type(time_type), intent(in) :: Time_local !< The model time at the end !! of the time step. @@ -1216,11 +1216,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + 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_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(forcing), intent(inout) :: fluxes !< pointers to forcing fields @@ -1239,7 +1239,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") @@ -1249,7 +1249,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call enable_averages(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then - call apply_oda_tracer_increments(US%T_to_s*dtdia,G,tv,h,CS%odaCS) + call apply_oda_tracer_increments(US%T_to_s*dtdia, G, GV, tv, h, CS%odaCS) endif if (associated(fluxes%p_surf) .or. associated(fluxes%p_surf_full)) then @@ -2035,7 +2035,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "initialize_MOM: A bulk mixed layer can only be used with T & S as "//& "state variables. Add USE_EOS = True to MOM_input.") - use_ice_shelf=.false. + use_ice_shelf = .false. if (present(ice_shelf_CSp)) then call get_param(param_file, "MOM", "ICE_SHELF", use_ice_shelf, & "If true, enables the ice shelf model.", default=.false.) @@ -2417,7 +2417,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 @@ -2553,8 +2553,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 @@ -2766,7 +2766,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. @@ -2818,7 +2818,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) if (CS%write_IC) then allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp - allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) + allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1)) call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') @@ -2872,32 +2872,32 @@ end subroutine register_diags subroutine MOM_timing_init(CS) type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM. - id_clock_ocean = cpu_clock_id('Ocean', grain=CLOCK_COMPONENT) - id_clock_dynamics = cpu_clock_id('Ocean dynamics', grain=CLOCK_SUBCOMPONENT) - id_clock_thermo = cpu_clock_id('Ocean thermodynamics and tracers', grain=CLOCK_SUBCOMPONENT) - id_clock_other = cpu_clock_id('Ocean Other', grain=CLOCK_SUBCOMPONENT) - id_clock_tracer = cpu_clock_id('(Ocean tracer advection)', grain=CLOCK_MODULE_DRIVER) - if (.not.CS%adiabatic) then - id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=CLOCK_MODULE_DRIVER) - else - id_clock_adiabatic = cpu_clock_id('(Ocean adiabatic driver)', grain=CLOCK_MODULE_DRIVER) - endif - - id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=CLOCK_MODULE) - id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE) - id_clock_pass = cpu_clock_id('(Ocean message passing *)', grain=CLOCK_MODULE) - id_clock_MOM_init = cpu_clock_id('(Ocean MOM_initialize_state)', grain=CLOCK_MODULE) - id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE) - if (CS%thickness_diffuse) & - id_clock_thick_diff = cpu_clock_id('(Ocean thickness diffusion *)', grain=CLOCK_MODULE) -!if (CS%mixedlayer_restrat) & - id_clock_ml_restrat = cpu_clock_id('(Ocean mixed layer restrat)', grain=CLOCK_MODULE) - id_clock_diagnostics = cpu_clock_id('(Ocean collective diagnostics)', grain=CLOCK_MODULE) - id_clock_Z_diag = cpu_clock_id('(Ocean Z-space diagnostics)', grain=CLOCK_MODULE) - id_clock_ALE = cpu_clock_id('(Ocean ALE)', grain=CLOCK_MODULE) - if (CS%offline_tracer_mode) then - id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT) - endif + id_clock_ocean = cpu_clock_id('Ocean', grain=CLOCK_COMPONENT) + id_clock_dynamics = cpu_clock_id('Ocean dynamics', grain=CLOCK_SUBCOMPONENT) + id_clock_thermo = cpu_clock_id('Ocean thermodynamics and tracers', grain=CLOCK_SUBCOMPONENT) + id_clock_other = cpu_clock_id('Ocean Other', grain=CLOCK_SUBCOMPONENT) + id_clock_tracer = cpu_clock_id('(Ocean tracer advection)', grain=CLOCK_MODULE_DRIVER) + if (.not.CS%adiabatic) then + id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=CLOCK_MODULE_DRIVER) + else + id_clock_adiabatic = cpu_clock_id('(Ocean adiabatic driver)', grain=CLOCK_MODULE_DRIVER) + endif + + id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=CLOCK_MODULE) + id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE) + id_clock_pass = cpu_clock_id('(Ocean message passing *)', grain=CLOCK_MODULE) + id_clock_MOM_init = cpu_clock_id('(Ocean MOM_initialize_state)', grain=CLOCK_MODULE) + id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE) + if (CS%thickness_diffuse) & + id_clock_thick_diff = cpu_clock_id('(Ocean thickness diffusion *)', grain=CLOCK_MODULE) + !if (CS%mixedlayer_restrat) & + id_clock_ml_restrat = cpu_clock_id('(Ocean mixed layer restrat)', grain=CLOCK_MODULE) + id_clock_diagnostics = cpu_clock_id('(Ocean collective diagnostics)', grain=CLOCK_MODULE) + id_clock_Z_diag = cpu_clock_id('(Ocean Z-space diagnostics)', grain=CLOCK_MODULE) + id_clock_ALE = cpu_clock_id('(Ocean ALE)', grain=CLOCK_MODULE) + if (CS%offline_tracer_mode) then + id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT) + endif end subroutine MOM_timing_init @@ -3331,7 +3331,7 @@ subroutine extract_surface_state(CS, sfc_state_in) sfc_state%ocean_heat(i,j) = 0.0 ; sfc_state%ocean_salt(i,j) = 0.0 enddo ; enddo !$OMP parallel do default(shared) private(mass) - do j=js,je ; do k=1,nz; do i=is,ie + do j=js,je ; do k=1,nz ; do i=is,ie mass = GV%H_to_RZ*h(i,j,k) sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + mass sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass * CS%tv%T(i,j,k) @@ -3367,12 +3367,12 @@ 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 numberOfErrors=0 ! count number of errors - do j=js,je; do i=is,ie + do j=js,je ; do i=is,ie if (G%mask2dT(i,j)>0.) then localError = sfc_state%sea_lev(i,j) <= -G%bathyT(i,j) & .or. sfc_state%sea_lev(i,j) >= CS%bad_val_ssh_max & diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e6a7f7698f..8dab711d32 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -114,23 +114,23 @@ module MOM_CoriolisAdv !> Calculates the Coriolis and momentum advection contributions to the acceleration. subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, 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] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy - !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx - !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis + 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_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: uh !< Zonal transport u*h*dy + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vh !< Meridional transport v*h*dx + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: CAu !< Zonal acceleration due to Coriolis !! and momentum advection [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: CAv !< Meridional acceleration due to Coriolis !! and momentum advection [L T-2 ~> m s-2]. - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -174,7 +174,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) min_fvq, & ! The minimum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. max_fuq, & ! The maximum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. min_fuq ! The minimum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. - real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [L T-2 ~> m s-2]. @@ -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. @@ -269,7 +269,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (Area_h(i+1,j) + Area_h(i,j+1)) enddo ; enddo - !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,CS,AD,Area_h,Area_q,& + !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,GV,CS,AD,Area_h,Area_q,& !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,h_neglect,h_tiny,OBC,eps_vel) do k=1,nz @@ -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,27 +924,28 @@ 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) - type(ocean_grid_type), intent(in) :: G !< Ocen 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] - real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] +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_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic !! energy gradient [L T-2 ~> m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic !! energy gradient [L T-2 ~> m s-2] - integer, intent(in) :: k !< Layer number to calculate for + integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. 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.F90 b/src/core/MOM_PressureForce.F90 index 1963a8a773..b4da255ddb 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -41,19 +41,19 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] type(PressureForce_CS), pointer :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean interface [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer !! due to eta anomalies [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), & diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 4fd1b583d3..e5e37ecc8d 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -74,36 +74,36 @@ module MOM_PressureForce_FV !! range before this subroutine is called: !! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg/m2] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure - type(ALE_CS), pointer :: ALE_CSp !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> kg/m2] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] + type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [ppt]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & S_t, & ! Top and bottom edge values for linear reconstructions S_b, & ! of salinity within each layer [ppt]. T_t, & ! Top and bottom edge values for linear reconstructions T_b ! of temperature within each layer [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & dza, & ! The change in geopotential anomaly between the top and bottom ! of a layer [L2 T-2 ~> m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less @@ -123,12 +123,12 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ real, dimension(SZIB_(G),SZJ_(G)) :: & intx_za ! The zonal integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing [L2 T-2 ~> m2 s-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & intx_dza ! The change in intx_za through a layer [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJB_(G)) :: & inty_za ! The meridional integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing [L2 T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & inty_dza ! The change in inty_za through a layer [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). @@ -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) @@ -414,25 +414,25 @@ end subroutine PressureForce_FV_nonBouss !! range before this subroutine is called: !! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure - type(ALE_CS), pointer :: ALE_CSp !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] + type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any !! tidal contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height in depth units [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. @@ -458,12 +458,12 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! interface atop a layer, divided by the grid spacing [R L2 T-2 ~> Pa]. inty_dpa ! The change in inty_pa through a layer [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [ppt]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions ! of salinity and temperature within each layer. real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. @@ -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) @@ -584,7 +584,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm enddo ; enddo endif !$OMP parallel do default(shared) - do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1 + do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1 e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index cade4e074d..ac5cb6c84c 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -61,34 +61,34 @@ module MOM_PressureForce_Mont !! range before this subroutine is called: !! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, [H ~> kg m-2]. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [L T-2 ~> m s-2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or - !! atmosphere-ocean [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: pbce !< The baroclinic pressure anomaly in - !! each layer due to free surface height anomalies, - !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2]. + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness, [H ~> kg m-2]. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients + !! (equal to -dM/dx) [L T-2 ~> m s-2]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients + !! (equal to -dM/dy) [L T-2 ~> m s-2]. + type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF + real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or + !! atmosphere-ocean [R L2 T-2 ~> Pa]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(out) :: pbce !< The baroclinic pressure anomaly in + !! each layer due to free surface height anomalies, + !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> kg m-1]. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. alpha_star, & ! Compression adjusted specific volume [R-1 ~> m3 kg-1]. dz_geo ! The change in geopotential across a layer [L2 T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. ! p may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility ! in seawater, but p will still be close to the pressure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter @@ -122,13 +122,13 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real :: I_gEarth ! The inverse of g_Earth [T2 Z L-2 ~> s2 m-1] ! real :: dalpha real :: Pa_to_H ! A factor to convert from R L2 T-2 to the thickness units (H). - real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. - real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each + real :: alpha_Lay(SZK_(GV)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. + real :: dalpha_int(SZK_(GV)+1) ! The change in specific volume across each ! interface [R-1 ~> m3 kg-1]. 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) @@ -358,32 +358,32 @@ end subroutine PressureForce_Mont_nonBouss !! range before this subroutine is called: !! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m]. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [L T-2 ~> m s2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m]. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients + !! (equal to -dM/dx) [L T-2 ~> m s-2]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients + !! (equal to -dM/dy) [L T-2 ~> m s2]. + type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF + real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies !! [L2 T-2 H-1 ~> m s-2]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. rho_star ! In-situ density divided by the derivative with depth of the ! corrected e times (G_Earth/Rho0) [m2 Z-1 s-2 ~> m s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height in m. ! e may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility ! in seawater, but e will still be close to the interface depth. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter @@ -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) @@ -606,18 +606,18 @@ end subroutine PressureForce_Mont_Bouss subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface height [Z ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Rho0 !< The "Boussinesq" ocean density [R ~> kg m-3]. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of !! the planet [nondim]. Usually this ratio is 1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due !! to free surface height anomalies !! [L2 T-2 H-1 ~> m s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility !! compensated), times g/rho_0 [L2 Z-1 T-2 ~> m s-2]. @@ -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 @@ -698,7 +698,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) - enddo ; enddo + enddo ; enddo enddo ! end of j loop endif ! use_EOS @@ -709,16 +709,16 @@ end subroutine Set_pbce_Bouss subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures [R L2 T-2 ~> Pa]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: p !< Interface pressures [R L2 T-2 ~> Pa]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of !! the planet [nondim]. Usually this ratio is 1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: pbce !< The baroclinic pressure anomaly in each !! layer due to free surface height anomalies !! [L2 H-1 T-2 ~> m4 kg-1 s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: alpha_star !< The layer specific volumes + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: alpha_star !< The layer specific volumes !! (maybe compressibility compensated) [R-1 ~> m3 kg-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -730,8 +730,8 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: rho_in_situ(SZI_(G)) ! In-situ density at an interface [R ~> kg m-3]. - real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. - real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each interface [R-1 ~> m3 kg-1]. + real :: alpha_Lay(SZK_(GV)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. + real :: dalpha_int(SZK_(GV)+1) ! The change in specific volume across each interface [R-1 ~> m3 kg-1]. real :: dP_dH ! A factor that converts from thickness to pressure times other dimensional ! conversion factors [R L2 T-2 H-1 ~> Pa m2 kg-1]. real :: dp_neglect ! A thickness that is so small it is usually lost @@ -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 47ac680ae9..06b1e95edc 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -411,19 +411,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: U_in !< The initial (3-D) zonal !! velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: V_in !< The initial (3-D) meridional !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height !! anomaly or column mass anomaly [H ~> m or kg m-2]. real, intent(in) :: dt !< The time increment to integrate over [T ~> s]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations, + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations, !! [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, !! [L T-2 ~> m s-2]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies !! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly or @@ -432,13 +432,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! eta_PF_start is provided [H ~> m or kg m-2]. !! Note: eta_in, pbce, and eta_PF_in must have up-to-date !! values in the first point of their halos. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due !! to the barotropic calculation [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer !! due to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. @@ -450,13 +450,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! [H L2 T-1 ~> m3 or kg s-1]. type(barotropic_CS), pointer :: CS !< The control structure returned by a !! previous call to barotropic_init. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: visc_rem_u !< Both the fraction of the momentum + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: visc_rem_u !< Both the fraction of the momentum !! originally in a layer that remains after a time-step of !! viscosity, and the fraction of a time-step's worth of a !! barotropic acceleration that a layer experiences after !! viscosity is applied, in the zonal direction. Nondimensional !! between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass !! averaged over the barotropic integration [H ~> m or kg m-2]. type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers @@ -484,8 +484,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis ! terms [L T-1 ~> m s-1]. - real :: wt_u(SZIB_(G),SZJ_(G),SZK_(G)) ! wt_u and wt_v are the - real :: wt_v(SZI_(G),SZJB_(G),SZK_(G)) ! normalized weights to + real :: wt_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! wt_u and wt_v are the + real :: wt_v(SZI_(G),SZJB_(G),SZK_(GV)) ! normalized weights to ! be used in calculating barotropic velocities, possibly with ! sums less than one due to viscous losses. Nondimensional. real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -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 @@ -1027,7 +1027,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo !$OMP parallel do default(shared) do J=js-1,je - do k=1,nz ; do i=is,ie + do k=1,nz ; do i=is,ie gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * wt_v(i,J,k) gtot_S(i,j+1) = gtot_S(i,j+1) + pbce(i,j+1,k) * wt_v(i,J,k) enddo ; enddo @@ -1496,7 +1496,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Set the mass source, after first initializing the halos to 0. !$OMP do - do j=jsvf-1,jevf+1; do i=isvf-1,ievf+1 ; eta_src(i,j) = 0.0 ; enddo ; enddo + do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1 ; eta_src(i,j) = 0.0 ; enddo ; enddo if (CS%bound_BT_corr) then ; if ((use_BT_Cont.or.integral_BT_cont) .and. CS%BT_cont_bounds) then do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then if (CS%eta_cor(i,j) > 0.0) then @@ -2648,7 +2648,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) type(barotropic_CS), pointer :: CS !< Barotropic control structure. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: pbce !< The baroclinic pressure !! anomaly in each layer due to free surface !! height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe @@ -2697,7 +2697,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, & @@ -3007,7 +3007,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 @@ -3080,7 +3080,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B endif endif ; enddo ; enddo if (OBC%Flather_u_BCs_exist_globally) then - do n = 1, OBC%number_of_segments + do n = 1, OBC%number_of_segments segment => OBC%segment(n) if (segment%is_E_or_W .and. segment%Flather) then do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB @@ -3134,7 +3134,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B endif endif ; enddo ; enddo if (OBC%Flather_v_BCs_exist_globally) then - do n = 1, OBC%number_of_segments + do n = 1, OBC%number_of_segments segment => OBC%segment(n) if (segment%is_N_or_S .and. segment%Flather) then do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied @@ -3184,13 +3184,13 @@ end subroutine destroy_BT_OBC subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(ocean_grid_type), intent(inout) :: 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: h_v !< The specified thicknesses at v-points [H ~> m or kg m-2]. logical, optional, intent(in) :: may_use_default !< An optional logical argument !! to indicate that the default velocity point @@ -3212,8 +3212,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) real :: wt_arith ! The nondimensional weight for the arithmetic mean thickness. ! The harmonic mean uses a weight of (1 - wt_arith). real :: Rh ! A ratio of summed thicknesses, nondim. - real :: e_u(SZIB_(G),SZK_(G)+1) ! The interface heights at u-velocity and - real :: e_v(SZI_(G),SZK_(G)+1) ! v-velocity points [H ~> m or kg m-2]. + real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity and + real :: e_v(SZI_(G),SZK_(GV)+1) ! v-velocity points [H ~> m or kg m-2]. real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths [H ~> m or kg m-2]. real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths [H ~> m or kg m-2]. real :: htot ! The sum of the layer thicknesses [H ~> m or kg m-2]. @@ -3250,7 +3250,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 @@ -3807,13 +3807,13 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain FA_v_NN(i,j) = 0.0 ; FA_v_N0(i,j) = 0.0 ; FA_v_S0(i,j) = 0.0 ; FA_v_SS(i,j) = 0.0 enddo ; enddo !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie uBT_EE(I,j) = BT_cont%uBT_EE(I,j) ; uBT_WW(I,j) = BT_cont%uBT_WW(I,j) FA_u_EE(I,j) = BT_cont%FA_u_EE(I,j) ; FA_u_E0(I,j) = BT_cont%FA_u_E0(I,j) FA_u_W0(I,j) = BT_cont%FA_u_W0(I,j) ; FA_u_WW(I,j) = BT_cont%FA_u_WW(I,j) enddo ; enddo !$OMP do - do J=js-1,je; do i=is,ie + do J=js-1,je ; do i=is,ie vBT_NN(i,J) = BT_cont%vBT_NN(i,J) ; vBT_SS(i,J) = BT_cont%vBT_SS(i,J) FA_v_NN(i,J) = BT_cont%FA_v_NN(i,J) ; FA_v_N0(i,J) = BT_cont%FA_v_N0(i,J) FA_v_S0(i,J) = BT_cont%FA_v_S0(i,J) ; FA_v_SS(i,J) = BT_cont%FA_v_SS(i,J) @@ -4147,7 +4147,7 @@ end subroutine find_face_areas subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be !! corrected [H ~> m or kg m-2]. logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective @@ -4169,7 +4169,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 @@ -4207,11 +4207,11 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: eta !< Free surface height or column mass anomaly @@ -4272,7 +4272,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 @@ -4581,7 +4581,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) @@ -4699,7 +4699,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..17712491c4 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 @@ -111,40 +111,26 @@ end subroutine call_OBC_register !> Calls appropriate routine to update the open boundary conditions. subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, 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(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thicknesses [H ~> m or kg m-2] - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - 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 + 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(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< layer thicknesses [H ~> m or kg m-2] + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(update_OBC_CS), pointer :: CS !< Control structure for OBCs + type(time_type), intent(in) :: Time !< Model time ! 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..a1c300c94f 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -44,16 +44,16 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] or other units. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: uh !< Volume flux through zonal faces = u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: vh !< Volume flux through meridional faces = v*h*dx !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -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 @@ -87,11 +86,11 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] or [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type, which is !! used to rescale u and v if present. @@ -99,17 +98,16 @@ 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 ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. - hs=1; if (present(haloshift)) hs=haloshift - sym=.false.; if (present(symmetric)) sym=symmetric + hs = 1 ; if (present(haloshift)) hs = haloshift + sym = .false. ; if (present(symmetric)) sym = symmetric call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=L_T_to_m_s) call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg @@ -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) @@ -182,42 +179,40 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: CAu !< Zonal acceleration due to Coriolis !! and momentum advection terms [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: CAv !< Meridional acceleration due to Coriolis !! and momentum advection terms [L T-2 ~> m s-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients !! (equal to -dM/dx) [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) [L T-2 ~> m s-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: diffu !< Zonal acceleration due to convergence of the !! along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: diffv !< Meridional acceleration due to convergence of !! the along-isopycnal stress tensor [L T-2 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the !! barotropic solver [L T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in !! the barotropic solver [L T-2 ~> m s-2]. 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 @@ -240,11 +235,11 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & intent(in) :: Temp !< Temperature [degC]. @@ -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.F90 b/src/core/MOM_continuity.F90 index cfb2b2e9fd..1ad37a82b8 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -43,18 +43,18 @@ subroutine continuity(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 !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: uh !< Volume flux through zonal faces = !! u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: vh !< Volume flux through meridional faces = !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. @@ -68,20 +68,20 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, !! flux through meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< Both the fraction of !! zonal momentum that remains after a time-step of viscosity, and the fraction of a time-step's !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_v !< Both the fraction of !! meridional momentum that remains after a time-step of viscosity, and the fraction of a time-step's !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor !< The zonal velocities that !! give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(out) :: v_cor !< The meridional velocities that !! give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. type(BT_cont_type), & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 995827959d..7b90297c64 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -76,21 +76,21 @@ 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)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & 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 @@ -100,24 +100,24 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that !! a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_v !< The fraction of meridional momentum originally !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that !! a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor !< The zonal velocities that give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(out) :: v_cor !< The meridional velocities that give vhbt as the depth-integrated !! transport [L T-1 ~> m s-1]. @@ -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 @@ -212,11 +212,11 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, BT_cont) 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)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. @@ -225,7 +225,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally in a layer that remains after a !! time-step of viscosity, and the fraction of a time-step's worth of a barotropic @@ -234,7 +234,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) !! that give uhbt as the depth-integrated transport, m s-1. @@ -242,8 +242,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZK_(GV)) :: duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & du, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. du_min_CFL, & ! Min/max limits on du correction @@ -252,7 +252,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & uh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZIB_(G)) :: do_I - real, dimension(SZIB_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZK_(GV)) :: & visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H L ~> m2 or kg m-1]. real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. @@ -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,17 +600,18 @@ 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. - 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 + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -618,7 +619,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, US, LB, vol_CFL, & !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the !! marginal face thicknesses; otherwise report transport-averaged thicknesses. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< Both the fraction of the momentum originally in a layer that remains after !! a time-step of viscosity, and the fraction of a time-step's worth of a @@ -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,17 +709,18 @@ 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. - 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 + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the + real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer !! experiences after viscosity is applied. @@ -747,11 +749,11 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & logical, optional, intent(in) :: full_precision !< !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: uh_3d !< !! Volume flux through zonal faces = u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZK_(GV)) :: & uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & @@ -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,15 +874,16 @@ 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. - 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 + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. @@ -895,7 +898,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. - real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the + real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer !! experiences after viscosity is applied. @@ -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 @@ -1036,20 +1039,20 @@ end subroutine set_zonal_BT_cont !> Calculates the mass or volume fluxes through the meridional faces, and other related quantities. subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_v, v_cor, BT_cont) - 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]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional - !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [T ~> s]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G - type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type + 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_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to + !! calculate fluxes [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: vh !< Volume flux through meridional + !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1] + real, intent(in) :: dt !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G + type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_v !< Both the fraction of the momentum !! originally in a layer that remains after a time-step of viscosity, !! and the fraction of a time-step's worth of a barotropic acceleration @@ -1057,16 +1060,16 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) !! that give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & dvhdv ! Partial derivative of vh with v [H L ~> m2 or kg m-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & dv, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. @@ -1078,7 +1081,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & logical, dimension(SZI_(G)) :: do_I real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H L ~> m2 or kg m-1]. real :: FA_v ! A sum of meridional face areas [H m ~> m2 or kg m-1]. - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by @@ -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,17 +1426,18 @@ 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. - 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, + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< 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, + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), 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, + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the reconstruction, !! [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: h_v !< Thickness at meridional faces, !! [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -1442,7 +1446,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, US, LB, vol_CFL, & !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the marginal !! face thicknesses; otherwise report transport-averaged thicknesses. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(in) :: visc_rem_v !< Both the fraction + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), optional, intent(in) :: visc_rem_v !< Both the fraction !! of the momentum originally in a layer that remains after a time-step of !! viscosity, and the fraction of a time-step's worth of a barotropic !! acceleration that a layer experiences after viscosity is applied. @@ -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,18 +1536,19 @@ 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. - 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]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& - 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]. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem + 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_(GV)), & + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),& + intent(in) :: h_L !< Left thickness in the reconstruction [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_R !< Right thickness in the reconstruction [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the momentum originally !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that @@ -1569,12 +1574,12 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 intent(in) :: do_I_in !< A flag indicating which I values to work on. logical, optional, intent(in) :: full_precision !< A flag indicating how carefully to !! iterate. The default is .true. (more accurate). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(inout) :: vh_3d !< Volume flux through meridional !! faces = v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & vh_aux, & ! An auxiliary meridional volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. real, dimension(SZI_(G)) :: & @@ -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,15 +1700,16 @@ 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. - 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, + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), 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, + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the reconstruction, !! [H ~> m or kg m-2]. type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. @@ -1718,7 +1724,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic !! acceleration that a layer experiences after viscosity is applied. @@ -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_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index d7d9c95b34..8d71cbcf65 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -1372,7 +1372,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, enddo ! 1. Compute vertical integrals - do j=Jsq,Jeq+1; do i=Isq,Ieq+1 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dp = p_b(i,j) - p_t(i,j) do n=1,5 ! T, S and p are linearly interpolated in the vertical. p5(n) = RL2_T2_to_Pa * (wt_t(n) * p_t(i,j) + wt_b(n) * p_b(i,j)) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 4ea6734511..e7c5a71930 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -245,11 +245,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & target, intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & target, intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related @@ -260,16 +260,16 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s !! time step [R L2 T-2 ~> Pa] real, dimension(:,:), pointer :: p_surf_end !< surf pressure at the end of this dynamic !! time step [R L2 T-2 ~> Pa] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & target, intent(inout) :: uh !< zonal volume/mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & target, intent(inout) :: vh !< merid volume/mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport !! since last tracer advection [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vhtr !< accumulatated merid volume/mass transport !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time @@ -284,17 +284,17 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s !! fields related to the surface wave conditions ! local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_bc_accel + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_bc_accel ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), target :: uh_in + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), target :: vh_in ! uh_in and vh_in are the zonal or meridional mass transports that would be ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -307,8 +307,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_old_rad_OBC + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1]. @@ -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 @@ -441,11 +441,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call disable_averaging(CS%diag) if (showCallTree) call callTree_wayPoint("done with PressureForce (step_MOM_dyn_split_RK2)") - if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then + if (associated(CS%OBC)) then ; if (CS%OBC%update_OBC) then call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) - endif; endif + 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 @@ -1077,14 +1077,15 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + 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_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) , & + intent(inout) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< current model time @@ -1118,7 +1119,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param !! from the continuity solver. ! local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -1137,7 +1138,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 @@ -1236,7 +1237,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 30544b0193..a8de99df47 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -191,9 +191,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical @@ -206,13 +206,13 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! pressure at the start of this dynamic step [R L2 T-2 ~> Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step [R L2 T-2 ~> Pa]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uh !< The zonal volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vh !< The meridional volume or mass !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< The accumulated zonal volume or mass !! transport since the last tracer advection [H L2 ~> m3 or kg]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< The accumulated meridional volume or mass !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or !! column mass [H ~> m or kg m-2]. @@ -226,15 +226,15 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! fields related to the surface wave conditions ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. 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 @@ -315,12 +315,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & CS%PressureForce_CSp, CS%ALE_CSp, p_surf) call cpu_clock_end(id_clock_pres) - if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then + if (associated(CS%OBC)) then ; if (CS%OBC%update_OBC) then call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) - endif; endif + 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) @@ -381,12 +381,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & CS%PressureForce_CSp, CS%ALE_CSp, p_surf) call cpu_clock_end(id_clock_pres) - if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then + if (associated(CS%OBC)) then ; if (CS%OBC%update_OBC) then call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) - endif; endif + 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 ) @@ -456,14 +456,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & CS%PressureForce_CSp, CS%ALE_CSp, p_surf) call cpu_clock_end(id_clock_pres) - if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then + if (associated(CS%OBC)) then ; if (CS%OBC%update_OBC) then call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) - endif; endif + endif ; endif ! 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))) @@ -559,11 +559,11 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse @@ -616,7 +616,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, & @@ -660,7 +660,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 2f93561c3f..c9da85fda9 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -193,11 +193,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u_in !< The input and output zonal !! velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v_in !< The input and output meridional !! velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_in !< The input and output layer thicknesses, !! [H ~> m or kg m-2], depending on whether !! the Boussinesq approximation is made. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -215,14 +215,14 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to !! the surface pressure at the end of !! this dynamic step [R L2 T-2 ~> Pa]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uh !< The zonal volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vh !< The meridional volume or mass !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last !! tracer advection [H L2 ~> m3 or kg]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< The accumulated meridional volume !! or mass transport since the last !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height @@ -236,15 +236,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! fields related to the Mesoscale !! Eddy Kinetic Energy. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s] 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 @@ -310,13 +310,13 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call pass_vector(CS%PFu, CS%PFv, G%Domain, clock=id_clock_pass) call pass_vector(CS%CAu, CS%CAv, G%Domain, clock=id_clock_pass) - if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then + if (associated(CS%OBC)) then ; if (CS%OBC%update_OBC) then call update_OBC_data(CS%OBC, G, GV, US, tv, h_in, CS%update_OBC_CSp, Time_local) - endif; endif + 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) @@ -370,7 +370,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) ?????????????????????/ @@ -507,9 +507,9 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse !! for run-time parameters. @@ -562,7 +562,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, & @@ -622,7 +622,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 99268747e1..afcfa11633 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -376,9 +376,9 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< layer temperatures [degC] real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over @@ -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 @@ -839,9 +839,9 @@ subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt, FluxRescaleDepth, !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: T !< layer temperatures [degC] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over @@ -893,12 +893,12 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt type(optics_type), pointer :: optics !< penetrating SW optics integer, intent(in) :: nsw !< The number of frequency bands of !! penetrating shortwave radiation - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< prognostic temp [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on - real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] + real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux @@ -917,7 +917,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R degC-1 ~> kg m-3 degC-1] real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R ppt-1 ~> kg m-3 ppt-1] - real, dimension(SZI_(G),SZK_(G)+1) :: netPen ! The net penetrating shortwave radiation at each level + real, dimension(SZI_(G),SZK_(GV)+1) :: netPen ! The net penetrating shortwave radiation at each level ! [degC H ~> degC m or degC kg m-2] logical :: useRiverHeatContent @@ -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 @@ -988,11 +988,11 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< SW ocean optics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux @@ -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 @@ -1305,20 +1303,20 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, ! This diagnostic is rescaled to MKS units when combined. handles%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, Time, & - 'Evaporation/condensation at ocean surface (evaporation is negative)', & - 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & - standard_name='water_evaporation_flux', cmor_field_name='evs', & - cmor_standard_name='water_evaporation_flux', & - cmor_long_name='Water Evaporation Flux Where Ice Free Ocean over Sea') + 'Evaporation/condensation at ocean surface (evaporation is negative)', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & + standard_name='water_evaporation_flux', cmor_field_name='evs', & + cmor_standard_name='water_evaporation_flux', & + cmor_long_name='Water Evaporation Flux Where Ice Free Ocean over Sea') ! smg: seaice_melt field requires updates to the sea ice model handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', & - diag%axesT1, Time, 'water flux to ocean from snow/sea ice melting(> 0) or formation(< 0)', & - 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & - standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & - cmor_field_name='fsitherm', & - cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics',& - cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)') + diag%axesT1, Time, 'water flux to ocean from snow/sea ice melting(> 0) or formation(< 0)', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & + standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & + cmor_field_name='fsitherm', & + cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics',& + cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)') handles%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, Time, & 'Liquid + frozen precipitation into ocean', 'kg m-2 s-1') diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index b8cf161148..ec7501c5f0 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -32,11 +32,11 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) 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_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights - !! [Z ~> m] or 1/eta_to_m m). + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: eta !< layer interface heights + !! [Z ~> m] or [1/eta_to_m m]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. @@ -47,9 +47,9 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !! the units of eta to m; by default this is US%Z_to_m. ! Local variables - real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa] - real :: dz_geo(SZI_(G),SZJ_(G),SZK_(G)) ! The change in geopotential height - ! across a layer [L2 T-2 ~> m2 s-2]. + real :: p(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa] + real :: dz_geo(SZI_(G),SZJ_(G),SZK_(GV)) ! The change in geopotential height + ! across a layer [L2 T-2 ~> m2 s-2]. real :: dilate(SZI_(G)) ! non-dimensional dilation factor real :: htot(SZI_(G)) ! total thickness [H ~> m or kg m-2] real :: I_gEarth ! The inverse of the gravitational acceleration times the @@ -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.") @@ -76,7 +76,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) if (GV%Boussinesq) then !$OMP do - do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev + do j=jsv,jev ; do k=nz,1,-1 ; do i=isv,iev eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo if (present(eta_bt)) then @@ -119,7 +119,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) enddo else !$OMP do - do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev + do j=jsv,jev ; do k=nz,1,-1 ; do i=isv,iev eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k) / GV%Rlay(k) enddo ; enddo ; enddo endif @@ -149,7 +149,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) 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_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height relative to @@ -162,9 +162,9 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) real, optional, intent(in) :: eta_to_m !< The conversion factor from !! the units of eta to m; by default this is US%Z_to_m. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & p ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & dz_geo ! The change in geopotential height across a layer [L2 T-2 ~> m2 s-2]. real :: htot(SZI_(G)) ! The sum of all layers' thicknesses [H ~> m or kg m-2]. real :: I_gEarth ! The inverse of the gravitational acceleration times the @@ -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..e1f573f6ea 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -30,19 +30,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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)+1), intent(in) :: e !< Interface heights [Z ~> m] or units + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface heights [Z ~> m] or units !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction [nondim] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction [nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at !! interfaces between u-points [T-2 ~> s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at !! interfaces between u-points [T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute @@ -51,13 +51,13 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units ! (This argument has been tested but for now serves no purpose.) !! of eta to m; US%Z_to_m by default. ! Local variables - real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & T, & ! The temperature [degC], with the values in ! in massless layers filled vertically by diffusion. S !, & ! The filled salinity [ppt], with the values in ! in massless layers filled vertically by diffusion. ! Rho ! Density itself, when a nonlinear equation of state is not in use [R ~> kg m-3]. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & + real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & pres ! The pressure at an interface [R L2 T-2 ~> Pa]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1]. @@ -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 @@ -388,27 +388,27 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, larger_h_denom) - 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] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] - real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing - !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] - integer, optional, intent(in) :: halo_here !< Number of halo points to work on, - !! 0 by default - logical, optional, intent(in) :: larger_h_denom !< Present and true, add a large - !! enough minimal thickness in the denominator of - !! the flux calculations so that the fluxes are - !! never so large as eliminate the transmission - !! of information across groups of massless layers. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T_in !< Input temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S_in !< Input salinity [ppt] + real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing + !! times a smoothing timescale [Z2 ~> m2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T_f !< Filled temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S_f !< Filled salinity [ppt] + integer, optional, intent(in) :: halo_here !< Number of halo points to work on, + !! 0 by default + logical, optional, intent(in) :: larger_h_denom !< Present and true, add a large + !! enough minimal thickness in the denominator of + !! the flux calculations so that the fluxes are + !! never so large as eliminate the transmission + !! of information across groups of massless layers. ! Local variables - real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz + real :: ent(SZI_(G),SZK_(GV)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. + real :: c1(SZI_(G),SZK_(GV)) ! tridiagonal solver. real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. real :: h0 ! A negligible thickness to allow for zero thickness layers without diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 0232ff91ff..3fc0c9bcba 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1338,10 +1338,10 @@ subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) Ie_obc = Ie_obc - G%idg_offset ! Convert to local tile indices on this tile if (Ie_obc>Is_obc) then - OBC%segment(l_seg)%direction = OBC_DIRECTION_S + OBC%segment(l_seg)%direction = OBC_DIRECTION_S elseif (Ie_obc Parse an OBC_SEGMENT_%%%_PARAMS string - subroutine parse_segment_param_real(segment_str, var, param_value, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of - !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed - real, intent(out) :: param_value !< The value of the parameter - logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages - ! Local variables - character(len=128) :: word1, word2, word3, method - integer :: lword, nfields, n, m - logical :: continue,dbg - character(len=32), dimension(MAX_OBC_FIELDS) :: flds - - nfields=0 - continue=.true. - dbg=.false. - if (PRESENT(debug)) dbg=debug - - do while (continue) - word1 = extract_word(segment_str,',',nfields+1) - if (trim(word1) == '') exit - nfields=nfields+1 - word2 = extract_word(word1,'=',1) - flds(nfields) = trim(word2) - enddo - - ! if (PRESENT(fields)) then - ! do n=1,nfields - ! fields(n) = flds(n) - ! enddo - ! endif - - ! if (PRESENT(num_fields)) then - ! num_fields=nfields - ! return - ! endif - - m=0 -! if (PRESENT(var)) then - do n=1,nfields - if (trim(var)==trim(flds(n))) then - m=n - exit - endif - enddo - if (m==0) then - call abort() - endif +subroutine parse_segment_param_real(segment_str, var, param_value, debug ) + character(len=*), intent(in) :: segment_str !< A string in form of + !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." + character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed + real, intent(out) :: param_value !< The value of the parameter + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages + ! Local variables + character(len=128) :: word1, word2, word3, method + integer :: lword, nfields, n, m + logical :: continue,dbg + character(len=32), dimension(MAX_OBC_FIELDS) :: flds + + nfields = 0 + continue = .true. + dbg = .false. + if (PRESENT(debug)) dbg = debug + + do while (continue) + word1 = extract_word(segment_str,',',nfields+1) + if (trim(word1) == '') exit + nfields = nfields+1 + word2 = extract_word(word1,'=',1) + flds(nfields) = trim(word2) + enddo + + ! if (PRESENT(fields)) then + ! do n=1,nfields + ! fields(n) = flds(n) + ! enddo + ! endif + + ! if (PRESENT(num_fields)) then + ! num_fields = nfields + ! return + ! endif + + m=0 +! if (PRESENT(var)) then + do n=1,nfields + if (trim(var)==trim(flds(n))) then + m = n + exit + endif + enddo + if (m==0) then + call abort() + endif ! Process first word which will start with the fieldname - word3 = extract_word(segment_str,',',m) + word3 = extract_word(segment_str,',',m) ! word1 = extract_word(word3,':',1) ! if (trim(word1) == '') exit - word2 = extract_word(word1,'=',1) - if (trim(word2) == trim(var)) then - method=trim(extract_word(word1,'=',2)) - lword=len_trim(method) - read(method(1:lword),*,err=987) param_value - ! if (method(lword-3:lword) == 'file') then - ! ! raise an error id filename/fieldname not in argument list - ! word1 = extract_word(word3,':',2) - ! filenam = extract_word(word1,'(',1) - ! fieldnam = extract_word(word1,'(',2) - ! lword=len_trim(fieldnam) - ! fieldnam = fieldnam(1:lword-1) ! remove trailing parenth - ! value=-999. - ! elseif (method(lword-4:lword) == 'value') then - ! filenam = 'none' - ! fieldnam = 'none' - ! word1 = extract_word(word3,':',2) - ! lword=len_trim(word1) - ! read(word1(1:lword),*,end=986,err=987) value - ! endif - endif -! endif + word2 = extract_word(word1,'=',1) + if (trim(word2) == trim(var)) then + method=trim(extract_word(word1,'=',2)) + lword=len_trim(method) + read(method(1:lword),*,err=987) param_value + ! if (method(lword-3:lword) == 'file') then + ! ! raise an error id filename/fieldname not in argument list + ! word1 = extract_word(word3,':',2) + ! filenam = extract_word(word1,'(',1) + ! fieldnam = extract_word(word1,'(',2) + ! lword=len_trim(fieldnam) + ! fieldnam = fieldnam(1:lword-1) ! remove trailing parenth + ! value=-999. + ! elseif (method(lword-4:lword) == 'value') then + ! filenam = 'none' + ! fieldnam = 'none' + ! word1 = extract_word(word3,':',2) + ! lword=len_trim(word1) + ! read(word1(1:lword),*,end=986,err=987) value + ! endif + endif +! endif - return - 986 call MOM_error(FATAL,'End of record while parsing segment data specification! '//trim(segment_str)) - 987 call MOM_error(FATAL,'Error while parsing segment parameter specification! '//trim(segment_str)) + return + 986 call MOM_error(FATAL,'End of record while parsing segment data specification! '//trim(segment_str)) + 987 call MOM_error(FATAL,'Error while parsing segment parameter specification! '//trim(segment_str)) - end subroutine parse_segment_param_real +end subroutine parse_segment_param_real !> Initialize open boundary control structure and do any necessary rescaling of OBC !! fields that have been read from a restart file. @@ -1860,7 +1860,7 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) OBC%cff_normal(I,J,k) = vel2_rescale * OBC%cff_normal(I,J,k) enddo ; enddo ; enddo endif - endif + endif end subroutine open_boundary_init @@ -2073,8 +2073,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() @@ -2087,7 +2088,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 @@ -2098,7 +2099,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 @@ -2111,20 +2112,21 @@ 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 - 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]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new !< On exit, new v values on open boundaries. - !! On entry, the old time-level v but including - !! barotropic accelerations [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v [L T-1 ~> m s-1] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: dt !< Appropriate timestep [T ~> s] +!> 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_(GV)), 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]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_old !< Original unadjusted u [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v_new !< On exit, new v values on open boundaries. + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_old !< Original unadjusted v [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: dt !< Appropriate timestep [T ~> s] ! Local variables real :: dhdt, dhdx, dhdy ! One-point differences in time or space [L T-1 ~> m s-1] real :: gamma_u, gamma_2 ! Fractional weightings of new values [nondim] @@ -2146,7 +2148,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 @@ -2163,14 +2165,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) @@ -2178,7 +2180,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) @@ -2187,7 +2189,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) @@ -2207,7 +2209,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 @@ -2218,7 +2220,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 @@ -2232,1003 +2234,1004 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) gamma_u = OBC%gamma_uv rx_max = OBC%rx_max ; ry_max = OBC%rx_max 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%direction == OBC_DIRECTION_E) then - I=segment%HI%IsdB - if (I 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed - if (gamma_u < 1.0) then - rx_avg = (1.0-gamma_u)*segment%rx_norm_rad(I,j,k) + gamma_u*rx_new - else - rx_avg = rx_new - endif - segment%rx_norm_rad(I,j,k) = rx_avg - ! The new boundary value is interpolated between future interior - ! value, u_new(I-1) and past boundary value but with barotropic - ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues - ! implemented as a work-around to limitations in restart capability - if (gamma_u < 1.0) then - OBC%rx_normal(I,j,k) = segment%rx_norm_rad(I,j,k) - endif - elseif (segment%oblique) then - dhdt = (u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new - dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 - if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then - dhdy = segment%grad_normal(J-1,1,k) - elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then - dhdy = 0.0 - else - dhdy = segment%grad_normal(J,1,k) - endif - if (dhdt*dhdx < 0.0) dhdt = 0.0 - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(dhdt*dhdx, cff_new*rx_max) - ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) - if (gamma_u < 1.0) then - rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new - ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new - cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new - else - rx_avg = rx_new - ry_avg = ry_new - cff_avg = cff_new - endif - segment%rx_norm_obl(I,j,k) = rx_avg - segment%ry_norm_obl(i,J,k) = ry_avg - segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & - min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & - (cff_avg + rx_avg) - if (gamma_u < 1.0) then - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary - ! implementation as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) - endif - elseif (segment%gradient) then - segment%normal_vel(I,j,k) = u_new(I-1,j,k) - endif - if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - ! dhdt gets set to 0 on inflow in oblique case - if (dhdt*dhdx <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%normal_vel(I,j,k) = (1.0 - gamma_2) * segment%normal_vel(I,j,k) + & - gamma_2 * segment%nudged_normal_vel(I,j,k) - endif - enddo ; enddo - if (segment%radiation_tan .or. segment%radiation_grad) then - I=segment%HI%IsdB - allocate(rx_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - rx_tang_rad(I,segment%HI%JsdB,k) = segment%rx_norm_rad(I,segment%HI%jsd,k) - rx_tang_rad(I,segment%HI%JedB,k) = segment%rx_norm_rad(I,segment%HI%jed,k) - do J=segment%HI%JsdB+1,segment%HI%JedB-1 - rx_tang_rad(I,J,k) = 0.5*(segment%rx_norm_rad(I,j,k) + segment%rx_norm_rad(I,j+1,k)) - enddo - else - do J=segment%HI%JsdB,segment%HI%JedB - dhdt = v_old(i,J,k)-v_new(i,J,k) !old-new - dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sasha for I-1 - rx_tang_rad(I,J,k) = 0.0 - if (dhdt*dhdx > 0.0) rx_tang_rad(I,J,k) = min( (dhdt/dhdx), rx_max) ! outward phase speed - enddo - endif - enddo - if (segment%radiation_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - rx_avg = rx_tang_rad(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) / (1.0+rx_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%radiation_grad) then - Js_obc = max(segment%HI%JsdB,G%jsd+1) - Je_obc = min(segment%HI%JedB,G%jed-1) - do k=1,nz ; do J=Js_obc,Je_obc - rx_avg = rx_tang_rad(I,J,k) -! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * dt * G%IdxBu(I-1,J) -! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = u_new(I-1,j,k) * dt * G%IdxBu(I-1,J) -! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = u_new(I-1,j+1,k) * dt * G%IdxBu(I-1,J) -! else -! rx_avg = 0.0 -! endif - segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & - rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(rx_tang_rad) - endif - if (segment%oblique_tan .or. segment%oblique_grad) then - I=segment%HI%IsdB - allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - rx_tang_obl(I,segment%HI%JsdB,k) = segment%rx_norm_obl(I,segment%HI%jsd,k) - rx_tang_obl(I,segment%HI%JedB,k) = segment%rx_norm_obl(I,segment%HI%jed,k) - ry_tang_obl(I,segment%HI%JsdB,k) = segment%ry_norm_obl(I,segment%HI%jsd,k) - ry_tang_obl(I,segment%HI%JedB,k) = segment%ry_norm_obl(I,segment%HI%jed,k) - cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) - cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) - do J=segment%HI%JsdB+1,segment%HI%JedB-1 - rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(I,j,k) + segment%rx_norm_obl(I,j+1,k)) - ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(I,j,k) + segment%ry_norm_obl(I,j+1,k)) - cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) - enddo - else - do J=segment%HI%JsdB,segment%HI%JedB - dhdt = v_old(i,J,k)-v_new(i,J,k) !old-new - dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sasha for I-1 - if (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) > 0.0) then - dhdy = segment%grad_tan(j,1,k) - elseif (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) == 0.0) then - dhdy = 0.0 - else - dhdy = segment%grad_tan(j+1,1,k) - endif - if (dhdt*dhdx < 0.0) dhdt = 0.0 - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(dhdt*dhdx, cff_new*rx_max) - ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new - enddo - endif - enddo - if (segment%oblique_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%oblique_grad) then - Js_obc = max(segment%HI%JsdB,G%jsd+1) - Je_obc = min(segment%HI%JedB,G%jed-1) - do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & - rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & - (cff_avg + rx_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(rx_tang_obl) - deallocate(ry_tang_obl) - deallocate(cff_tangential) - endif - endif - - if (segment%direction == OBC_DIRECTION_W) then - I=segment%HI%IsdB - if (I>G%HI%IecB) cycle - do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed - if (segment%radiation) then - dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 - rx_new = 0.0 - if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) - if (gamma_u < 1.0) then - rx_avg = (1.0-gamma_u)*segment%rx_norm_rad(I,j,k) + gamma_u*rx_new - else - rx_avg = rx_new - endif - segment%rx_norm_rad(I,j,k) = rx_avg - ! The new boundary value is interpolated between future interior - ! value, u_new(I+1) and past boundary value but with barotropic - ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) - if (gamma_u < 1.0) then - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues - ! implemented as a work-around to limitations in restart capability - OBC%rx_normal(I,j,k) = segment%rx_norm_rad(I,j,k) - endif - elseif (segment%oblique) then - dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 - if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then - dhdy = segment%grad_normal(J-1,1,k) - elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then - dhdy = 0.0 - else - dhdy = segment%grad_normal(J,1,k) - endif - if (dhdt*dhdx < 0.0) dhdt = 0.0 - - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(dhdt*dhdx, cff_new*rx_max) - ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) - if (gamma_u < 1.0) then - rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new - ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new - cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new - else - rx_avg = rx_new - ry_avg = ry_new - cff_avg = cff_new - endif - segment%rx_norm_obl(I,j,k) = rx_avg - segment%ry_norm_obl(i,J,k) = ry_avg - segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & - min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & - (cff_avg + rx_avg) - if (gamma_u < 1.0) then - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues - ! implemented as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) - endif - elseif (segment%gradient) then - segment%normal_vel(I,j,k) = u_new(I+1,j,k) - endif - if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - ! dhdt gets set to 0. on inflow in oblique case - if (dhdt*dhdx <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%normal_vel(I,j,k) = (1.0 - gamma_2) * segment%normal_vel(I,j,k) + & - gamma_2 * segment%nudged_normal_vel(I,j,k) - endif - enddo ; enddo - if (segment%radiation_tan .or. segment%radiation_grad) then - I=segment%HI%IsdB - allocate(rx_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - rx_tang_rad(I,segment%HI%JsdB,k) = segment%rx_norm_rad(I,segment%HI%jsd,k) - rx_tang_rad(I,segment%HI%JedB,k) = segment%rx_norm_rad(I,segment%HI%jed,k) - do J=segment%HI%JsdB+1,segment%HI%JedB-1 - rx_tang_rad(I,J,k) = 0.5*(segment%rx_norm_rad(I,j,k) + segment%rx_norm_rad(I,j+1,k)) - enddo - else - do J=segment%HI%JsdB,segment%HI%JedB - dhdt = v_old(i+1,J,k)-v_new(i+1,J,k) !old-new - dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sasha for I-1 - rx_tang_rad(I,J,k) = 0.0 - if (dhdt*dhdx > 0.0) rx_tang_rad(I,J,k) = min( (dhdt/dhdx), rx_max) ! outward phase speed - enddo - endif - enddo - if (segment%radiation_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - rx_avg = rx_tang_rad(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%radiation_grad) then - Js_obc = max(segment%HI%JsdB,G%jsd+1) - Je_obc = min(segment%HI%JedB,G%jed-1) - do k=1,nz ; do J=Js_obc,Je_obc - rx_avg = rx_tang_rad(I,J,k) -! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * dt * G%IdxBu(I+1,J) -! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = u_new(I+1,j,k) * dt * G%IdxBu(I+1,J) -! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = u_new(I+1,j+1,k) * dt * G%IdxBu(I+1,J) -! else -! rx_avg = 0.0 -! endif - segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & - rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(rx_tang_rad) - endif - if (segment%oblique_tan .or. segment%oblique_grad) then - I=segment%HI%IsdB - allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - rx_tang_obl(I,segment%HI%JsdB,k) = segment%rx_norm_obl(I,segment%HI%jsd,k) - rx_tang_obl(I,segment%HI%JedB,k) = segment%rx_norm_obl(I,segment%HI%jed,k) - ry_tang_obl(I,segment%HI%JsdB,k) = segment%ry_norm_obl(I,segment%HI%jsd,k) - ry_tang_obl(I,segment%HI%JedB,k) = segment%ry_norm_obl(I,segment%HI%jed,k) - cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) - cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) - do J=segment%HI%JsdB+1,segment%HI%JedB-1 - rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(I,j,k) + segment%rx_norm_obl(I,j+1,k)) - ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(I,j,k) + segment%ry_norm_obl(I,j+1,k)) - cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) - enddo - else - do J=segment%HI%JsdB,segment%HI%JedB - dhdt = v_old(i+1,J,k)-v_new(i+1,J,k) !old-new - dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sasha for I-1 - if (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) > 0.0) then - dhdy = segment%grad_tan(j,1,k) - elseif (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) == 0.0) then - dhdy = 0.0 - else - dhdy = segment%grad_tan(j+1,1,k) - endif - if (dhdt*dhdx < 0.0) dhdt = 0.0 - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(dhdt*dhdx, cff_new*rx_max) - ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new - enddo - endif - enddo - if (segment%oblique_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%oblique_grad) then - Js_obc = max(segment%HI%JsdB,G%jsd+1) - Je_obc = min(segment%HI%JedB,G%jed-1) - do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & - rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (rx_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(rx_tang_obl) - deallocate(ry_tang_obl) - deallocate(cff_tangential) - endif - endif - - if (segment%direction == OBC_DIRECTION_N) then - J=segment%HI%JsdB - if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) - if (gamma_u < 1.0) then - ry_avg = (1.0-gamma_u)*segment%ry_norm_rad(I,j,k) + gamma_u*ry_new - else - ry_avg = ry_new - endif - segment%ry_norm_rad(i,J,k) = ry_avg - ! The new boundary value is interpolated between future interior - ! value, v_new(J-1) and past boundary value but with barotropic - ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) - if (gamma_u < 1.0) then - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues - ! implemented as a work-around to limitations in restart capability - OBC%ry_normal(i,J,k) = segment%ry_norm_rad(i,J,k) - endif - elseif (segment%oblique) then - dhdt = (v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new - dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 - if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then - dhdx = segment%grad_normal(I-1,1,k) - elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then - dhdx = 0.0 - else - dhdx = segment%grad_normal(I,1,k) - endif - if (dhdt*dhdy < 0.0) dhdt = 0.0 - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(dhdt*dhdy, cff_new*ry_max) - rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) - if (gamma_u < 1.0) then - rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new - ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new - cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new - else - rx_avg = rx_new - ry_avg = ry_new - cff_avg = cff_new - endif - segment%rx_norm_obl(I,j,k) = rx_avg - segment%ry_norm_obl(i,J,k) = ry_avg - segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& - min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) - if (gamma_u < 1.0) then - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues - ! implemented as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) - endif - elseif (segment%gradient) then - segment%normal_vel(i,J,k) = v_new(i,J-1,k) - endif - if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - ! dhdt gets set to 0 on inflow in oblique case - if (dhdt*dhdy <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%normal_vel(i,J,k) = (1.0 - gamma_2) * segment%normal_vel(i,J,k) + & - gamma_2 * segment%nudged_normal_vel(i,J,k) - endif - enddo ; enddo - if (segment%radiation_tan .or. segment%radiation_grad) then - J=segment%HI%JsdB - allocate(ry_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - ry_tang_rad(segment%HI%IsdB,J,k) = segment%ry_norm_rad(segment%HI%isd,J,k) - ry_tang_rad(segment%HI%IedB,J,k) = segment%ry_norm_rad(segment%HI%ied,J,k) - do I=segment%HI%IsdB+1,segment%HI%IedB-1 - ry_tang_rad(I,J,k) = 0.5*(segment%ry_norm_rad(i,J,k) + segment%ry_norm_rad(i+1,J,k)) - enddo - else - do I=segment%HI%IsdB,segment%HI%IedB - dhdt = u_old(I,j-1,k)-u_new(I,j-1,k) !old-new - dhdy = u_new(I,j-1,k)-u_new(I,j-2,k) !in new time backward sasha for I-1 - ry_tang_rad(I,J,k) = 0.0 - if (dhdt*dhdy > 0.0) ry_tang_rad(I,J,k) = min( (dhdt/dhdy), rx_max) ! outward phase speed - enddo - endif - enddo - if (segment%radiation_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ry_avg = ry_tang_rad(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j,k) + ry_avg*u_new(I,j-1,k)) / (1.0+ry_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%radiation_grad) then - Is_obc = max(segment%HI%IsdB,G%isd+1) - Ie_obc = min(segment%HI%IedB,G%ied-1) - do k=1,nz ; do I=Is_obc,Ie_obc - ry_avg = ry_tang_rad(I,J,k) -! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! ry_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * dt * G%IdyBu(I,J-1)) -! elseif (G%mask2dCv(i,J-1) > 0.0) then -! ry_avg = v_new(i,J-1,k) * dt *G%IdyBu(I,J-1) -! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! ry_avg = v_new(i+1,J-1,k) * dt *G%IdyBu(I,J-1) -! else -! ry_avg = 0.0 -! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & - ry_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+ry_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(ry_tang_rad) - endif - if (segment%oblique_tan .or. segment%oblique_grad) then - J=segment%HI%JsdB - allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - rx_tang_obl(segment%HI%IsdB,J,k) = segment%rx_norm_obl(segment%HI%isd,J,k) - rx_tang_obl(segment%HI%IedB,J,k) = segment%rx_norm_obl(segment%HI%ied,J,k) - ry_tang_obl(segment%HI%IsdB,J,k) = segment%ry_norm_obl(segment%HI%isd,J,k) - ry_tang_obl(segment%HI%IedB,J,k) = segment%ry_norm_obl(segment%HI%ied,J,k) - cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) - cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) - do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(i,J,k) + segment%rx_norm_obl(i+1,J,k)) - ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(i,J,k) + segment%ry_norm_obl(i+1,J,k)) - cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) - enddo - else - do I=segment%HI%IsdB,segment%HI%IedB - dhdt = u_old(I,j,k)-u_new(I,j,k) !old-new - dhdy = u_new(I,j,k)-u_new(I,j-1,k) !in new time backward sasha for I-1 - if (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) > 0.0) then - dhdx = segment%grad_tan(i,1,k) - elseif (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) == 0.0) then - dhdx = 0.0 - else - dhdx = segment%grad_tan(i+1,1,k) - endif - if (dhdt*dhdy < 0.0) dhdt = 0.0 - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(dhdt*dhdy, cff_new*ry_max) - rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new - enddo - endif - enddo - if (segment%oblique_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + ry_avg*u_new(I,j-1,k)) - & - (max(rx_avg,0.0)*segment%grad_tan(i,2,k) + & - min(rx_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + ry_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%oblique_grad) then - Is_obc = max(segment%HI%IsdB,G%isd+1) - Ie_obc = min(segment%HI%IedB,G%ied-1) - do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & - ry_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - (max(rx_avg,0.0)*segment%grad_gradient(I,2,k) + & - min(rx_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & - (cff_avg + ry_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(rx_tang_obl) - deallocate(ry_tang_obl) - deallocate(cff_tangential) - endif - endif - - if (segment%direction == OBC_DIRECTION_S) then - J=segment%HI%JsdB - if (J>G%HI%JecB) cycle - do k=1,nz ; do i=segment%HI%isd,segment%HI%ied - if (segment%radiation) then - dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 - ry_new = 0.0 - if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) - if (gamma_u < 1.0) then - ry_avg = (1.0-gamma_u)*segment%ry_norm_rad(I,j,k) + gamma_u*ry_new - else - ry_avg = ry_new - endif - segment%ry_norm_rad(i,J,k) = ry_avg - ! The new boundary value is interpolated between future interior - ! value, v_new(J+1) and past boundary value but with barotropic - ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) - if (gamma_u < 1.0) then - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues - ! implemented as a work-around to limitations in restart capability - OBC%ry_normal(i,J,k) = segment%ry_norm_rad(i,J,k) - endif - elseif (segment%oblique) then - dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 - if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then - dhdx = segment%grad_normal(I-1,1,k) - elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then - dhdx = 0.0 - else - dhdx = segment%grad_normal(I,1,k) - endif - if (dhdt*dhdy < 0.0) dhdt = 0.0 - - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(dhdt*dhdy, cff_new*ry_max) - rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) - if (gamma_u < 1.0) then - rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new - ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new - cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new - else - rx_avg = rx_new - ry_avg = ry_new - cff_avg = cff_new - endif - segment%rx_norm_obl(I,j,k) = rx_avg - segment%ry_norm_obl(i,J,k) = ry_avg - segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & - min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) - if (gamma_u < 1.0) then - ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues - ! implemented as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) - endif - elseif (segment%gradient) then - segment%normal_vel(i,J,k) = v_new(i,J+1,k) - endif - if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - ! dhdt gets set to 0 on inflow in oblique case - if (dhdt*dhdy <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%normal_vel(i,J,k) = (1.0 - gamma_2) * segment%normal_vel(i,J,k) + & - gamma_2 * segment%nudged_normal_vel(i,J,k) - endif - enddo ; enddo - if (segment%radiation_tan .or. segment%radiation_grad) then - J=segment%HI%JsdB - allocate(ry_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - ry_tang_rad(segment%HI%IsdB,J,k) = segment%ry_norm_rad(segment%HI%isd,J,k) - ry_tang_rad(segment%HI%IedB,J,k) = segment%ry_norm_rad(segment%HI%ied,J,k) - do I=segment%HI%IsdB+1,segment%HI%IedB-1 - ry_tang_rad(I,J,k) = 0.5*(segment%ry_norm_rad(i,J,k) + segment%ry_norm_rad(i+1,J,k)) - enddo - else - do I=segment%HI%IsdB,segment%HI%IedB - dhdt = u_old(I,j+1,k)-u_new(I,j+1,k) !old-new - dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sasha for I-1 - ry_tang_rad(I,J,k) = 0.0 - if (dhdt*dhdy > 0.0) ry_tang_rad(I,J,k) = min( (dhdt/dhdy), rx_max) ! outward phase speed - enddo - endif - enddo - if (segment%radiation_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ry_avg = ry_tang_rad(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + ry_avg*u_new(I,j+2,k)) / (1.0+ry_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%radiation_grad) then - Is_obc = max(segment%HI%IsdB,G%isd+1) - Ie_obc = min(segment%HI%IedB,G%ied-1) - do k=1,nz ; do I=Is_obc,Ie_obc - ry_avg = ry_tang_rad(I,J,k) -! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! ry_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * dt * G%IdyBu(I,J+1) -! elseif (G%mask2dCv(i,J+1) > 0.0) then -! ry_avg = v_new(i,J+1,k) * dt * G%IdyBu(I,J+1) -! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! ry_avg = v_new(i+1,J+1,k) * dt * G%IdyBu(I,J+1) -! else -! ry_avg = 0.0 -! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & - ry_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+ry_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_rad(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(ry_tang_rad) - endif - if (segment%oblique_tan .or. segment%oblique_grad) then - J=segment%HI%JsdB - allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) - do k=1,nz - if (gamma_u < 1.0) then - rx_tang_obl(segment%HI%IsdB,J,k) = segment%rx_norm_obl(segment%HI%isd,J,k) - rx_tang_obl(segment%HI%IedB,J,k) = segment%rx_norm_obl(segment%HI%ied,J,k) - ry_tang_obl(segment%HI%IsdB,J,k) = segment%ry_norm_obl(segment%HI%isd,J,k) - ry_tang_obl(segment%HI%IedB,J,k) = segment%ry_norm_obl(segment%HI%ied,J,k) - cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) - cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) - do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(i,J,k) + segment%rx_norm_obl(i+1,J,k)) - ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(i,J,k) + segment%ry_norm_obl(i+1,J,k)) - cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) - enddo - else - do I=segment%HI%IsdB,segment%HI%IedB - dhdt = u_old(I,j+1,k)-u_new(I,j+1,k) !old-new - dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sasha for I-1 - if (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) > 0.0) then - dhdx = segment%grad_tan(i,1,k) - elseif (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) == 0.0) then - dhdx = 0.0 - else - dhdx = segment%grad_tan(i+1,1,k) - endif - if (dhdt*dhdy < 0.0) dhdt = 0.0 - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(dhdt*dhdy, cff_new*ry_max) - rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new - enddo - endif - enddo - if (segment%oblique_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + ry_avg*u_new(I,j+2,k)) - & - (max(rx_avg,0.0)*segment%grad_tan(i,2,k) + & - min(rx_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & - (cff_avg + ry_avg) - enddo ; enddo - endif - if (segment%nudged_tan) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) - enddo ; enddo - endif - if (segment%oblique_grad) then - Is_obc = max(segment%HI%IsdB,G%isd+1) - Ie_obc = min(segment%HI%IedB,G%ied-1) - do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_avg = rx_tang_obl(I,J,k) - ry_avg = ry_tang_obl(I,J,k) - cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & - ry_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - (max(rx_avg,0.0)*segment%grad_gradient(i,2,k) + & - min(rx_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & - (cff_avg + ry_avg) - enddo ; enddo - endif - if (segment%nudged_grad) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - ! dhdt gets set to 0 on inflow in oblique case - if (ry_tang_obl(I,J,k) <= 0.0) then - tau = segment%Velocity_nudging_timescale_in - else - tau = segment%Velocity_nudging_timescale_out - endif - gamma_2 = dt / (tau + dt) - segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & - gamma_2 * segment%nudged_tangential_grad(I,J,k) - enddo ; enddo - endif - deallocate(rx_tang_obl) - deallocate(ry_tang_obl) - deallocate(cff_tangential) - endif - endif + segment=>OBC%segment(n) + if (.not. segment%on_pe) cycle + 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 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed + if (gamma_u < 1.0) then + rx_avg = (1.0-gamma_u)*segment%rx_norm_rad(I,j,k) + gamma_u*rx_new + else + rx_avg = rx_new + endif + segment%rx_norm_rad(I,j,k) = rx_avg + ! The new boundary value is interpolated between future interior + ! value, u_new(I-1) and past boundary value but with barotropic + ! accelerations, u_new(I). + segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + if (gamma_u < 1.0) then + OBC%rx_normal(I,j,k) = segment%rx_norm_rad(I,j,k) + endif + elseif (segment%oblique) then + dhdt = (u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 + if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then + dhdy = segment%grad_normal(J-1,1,k) + elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then + dhdy = 0.0 + else + dhdy = segment%grad_normal(J,1,k) + endif + if (dhdt*dhdx < 0.0) dhdt = 0.0 + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) + ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) + if (gamma_u < 1.0) then + rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + else + rx_avg = rx_new + ry_avg = ry_new + cff_avg = cff_new + endif + segment%rx_norm_obl(I,j,k) = rx_avg + segment%ry_norm_obl(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) + if (gamma_u < 1.0) then + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary + ! implementation as a work-around to limitations in restart capability + OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) + endif + elseif (segment%gradient) then + segment%normal_vel(I,j,k) = u_new(I-1,j,k) + endif + if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%normal_vel(I,j,k) = (1.0 - gamma_2) * segment%normal_vel(I,j,k) + & + gamma_2 * segment%nudged_normal_vel(I,j,k) + endif + enddo ; enddo + if (segment%radiation_tan .or. segment%radiation_grad) then + I=segment%HI%IsdB + allocate(rx_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + rx_tang_rad(I,segment%HI%JsdB,k) = segment%rx_norm_rad(I,segment%HI%jsd,k) + rx_tang_rad(I,segment%HI%JedB,k) = segment%rx_norm_rad(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tang_rad(I,J,k) = 0.5*(segment%rx_norm_rad(I,j,k) + segment%rx_norm_rad(I,j+1,k)) + enddo + else + do J=segment%HI%JsdB,segment%HI%JedB + dhdt = v_old(i,J,k)-v_new(i,J,k) !old-new + dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sasha for I-1 + rx_tang_rad(I,J,k) = 0.0 + if (dhdt*dhdx > 0.0) rx_tang_rad(I,J,k) = min( (dhdt/dhdx), rx_max) ! outward phase speed + enddo + endif + enddo + if (segment%radiation_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tang_rad(I,J,k) + segment%tangential_vel(I,J,k) = (v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) / (1.0+rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%radiation_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=Js_obc,Je_obc + rx_avg = rx_tang_rad(I,J,k) +! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * dt * G%IdxBu(I-1,J) +! elseif (G%mask2dCu(I-1,j) > 0.0) then +! rx_avg = u_new(I-1,j,k) * dt * G%IdxBu(I-1,J) +! elseif (G%mask2dCu(I-1,j+1) > 0.0) then +! rx_avg = u_new(I-1,j+1,k) * dt * G%IdxBu(I-1,J) +! else +! rx_avg = 0.0 +! endif + segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tang_rad) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + rx_tang_obl(I,segment%HI%JsdB,k) = segment%rx_norm_obl(I,segment%HI%jsd,k) + rx_tang_obl(I,segment%HI%JedB,k) = segment%rx_norm_obl(I,segment%HI%jed,k) + ry_tang_obl(I,segment%HI%JsdB,k) = segment%ry_norm_obl(I,segment%HI%jsd,k) + ry_tang_obl(I,segment%HI%JedB,k) = segment%ry_norm_obl(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(I,j,k) + segment%rx_norm_obl(I,j+1,k)) + ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(I,j,k) + segment%ry_norm_obl(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + else + do J=segment%HI%JsdB,segment%HI%JedB + dhdt = v_old(i,J,k)-v_new(i,J,k) !old-new + dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sasha for I-1 + if (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) > 0.0) then + dhdy = segment%grad_tan(j,1,k) + elseif (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) == 0.0) then + dhdy = 0.0 + else + dhdy = segment%grad_tan(j+1,1,k) + endif + if (dhdt*dhdx < 0.0) dhdt = 0.0 + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) + ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) + rx_tang_obl(I,j,k) = rx_new + ry_tang_obl(i,J,k) = ry_new + cff_tangential(i,J,k) = cff_new + enddo + endif + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tang_obl) + deallocate(ry_tang_obl) + deallocate(cff_tangential) + endif + endif + + if (segment%direction == OBC_DIRECTION_W) then + I=segment%HI%IsdB + if (I>G%HI%IecB) cycle + do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed + if (segment%radiation) then + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + rx_new = 0.0 + if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) + if (gamma_u < 1.0) then + rx_avg = (1.0-gamma_u)*segment%rx_norm_rad(I,j,k) + gamma_u*rx_new + else + rx_avg = rx_new + endif + segment%rx_norm_rad(I,j,k) = rx_avg + ! The new boundary value is interpolated between future interior + ! value, u_new(I+1) and past boundary value but with barotropic + ! accelerations, u_new(I). + segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) + if (gamma_u < 1.0) then + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_normal(I,j,k) = segment%rx_norm_rad(I,j,k) + endif + elseif (segment%oblique) then + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then + dhdy = segment%grad_normal(J-1,1,k) + elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then + dhdy = 0.0 + else + dhdy = segment%grad_normal(J,1,k) + endif + if (dhdt*dhdx < 0.0) dhdt = 0.0 + + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) + ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) + if (gamma_u < 1.0) then + rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new + else + rx_avg = rx_new + ry_avg = ry_new + cff_avg = cff_new + endif + segment%rx_norm_obl(I,j,k) = rx_avg + segment%ry_norm_obl(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) + if (gamma_u < 1.0) then + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) + endif + elseif (segment%gradient) then + segment%normal_vel(I,j,k) = u_new(I+1,j,k) + endif + if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then + ! dhdt gets set to 0. on inflow in oblique case + if (dhdt*dhdx <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%normal_vel(I,j,k) = (1.0 - gamma_2) * segment%normal_vel(I,j,k) + & + gamma_2 * segment%nudged_normal_vel(I,j,k) + endif + enddo ; enddo + if (segment%radiation_tan .or. segment%radiation_grad) then + I=segment%HI%IsdB + allocate(rx_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + rx_tang_rad(I,segment%HI%JsdB,k) = segment%rx_norm_rad(I,segment%HI%jsd,k) + rx_tang_rad(I,segment%HI%JedB,k) = segment%rx_norm_rad(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tang_rad(I,J,k) = 0.5*(segment%rx_norm_rad(I,j,k) + segment%rx_norm_rad(I,j+1,k)) + enddo + else + do J=segment%HI%JsdB,segment%HI%JedB + dhdt = v_old(i+1,J,k)-v_new(i+1,J,k) !old-new + dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sasha for I-1 + rx_tang_rad(I,J,k) = 0.0 + if (dhdt*dhdx > 0.0) rx_tang_rad(I,J,k) = min( (dhdt/dhdx), rx_max) ! outward phase speed + enddo + endif + enddo + if (segment%radiation_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tang_rad(I,J,k) + segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%radiation_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=Js_obc,Je_obc + rx_avg = rx_tang_rad(I,J,k) +! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * dt * G%IdxBu(I+1,J) +! elseif (G%mask2dCu(I+1,j) > 0.0) then +! rx_avg = u_new(I+1,j,k) * dt * G%IdxBu(I+1,J) +! elseif (G%mask2dCu(I+1,j+1) > 0.0) then +! rx_avg = u_new(I+1,j+1,k) * dt * G%IdxBu(I+1,J) +! else +! rx_avg = 0.0 +! endif + segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tang_rad) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + rx_tang_obl(I,segment%HI%JsdB,k) = segment%rx_norm_obl(I,segment%HI%jsd,k) + rx_tang_obl(I,segment%HI%JedB,k) = segment%rx_norm_obl(I,segment%HI%jed,k) + ry_tang_obl(I,segment%HI%JsdB,k) = segment%ry_norm_obl(I,segment%HI%jsd,k) + ry_tang_obl(I,segment%HI%JedB,k) = segment%ry_norm_obl(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(I,j,k) + segment%rx_norm_obl(I,j+1,k)) + ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(I,j,k) + segment%ry_norm_obl(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + else + do J=segment%HI%JsdB,segment%HI%JedB + dhdt = v_old(i+1,J,k)-v_new(i+1,J,k) !old-new + dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sasha for I-1 + if (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) > 0.0) then + dhdy = segment%grad_tan(j,1,k) + elseif (dhdt*(segment%grad_tan(j,1,k) + segment%grad_tan(j+1,1,k)) == 0.0) then + dhdy = 0.0 + else + dhdy = segment%grad_tan(j+1,1,k) + endif + if (dhdt*dhdx < 0.0) dhdt = 0.0 + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) + ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) + rx_tang_obl(I,j,k) = rx_new + ry_tang_obl(i,J,k) = ry_new + cff_tangential(i,J,k) = cff_new + enddo + endif + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tang_obl) + deallocate(ry_tang_obl) + deallocate(cff_tangential) + endif + endif + + if (segment%direction == OBC_DIRECTION_N) then + J=segment%HI%JsdB + if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) + if (gamma_u < 1.0) then + ry_avg = (1.0-gamma_u)*segment%ry_norm_rad(I,j,k) + gamma_u*ry_new + else + ry_avg = ry_new + endif + segment%ry_norm_rad(i,J,k) = ry_avg + ! The new boundary value is interpolated between future interior + ! value, v_new(J-1) and past boundary value but with barotropic + ! accelerations, v_new(J). + segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) + if (gamma_u < 1.0) then + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%ry_normal(i,J,k) = segment%ry_norm_rad(i,J,k) + endif + elseif (segment%oblique) then + dhdt = (v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new + dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 + if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then + dhdx = segment%grad_normal(I-1,1,k) + elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then + dhdx = 0.0 + else + dhdx = segment%grad_normal(I,1,k) + endif + if (dhdt*dhdy < 0.0) dhdt = 0.0 + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) + rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) + if (gamma_u < 1.0) then + rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + else + rx_avg = rx_new + ry_avg = ry_new + cff_avg = cff_new + endif + segment%rx_norm_obl(I,j,k) = rx_avg + segment%ry_norm_obl(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) + if (gamma_u < 1.0) then + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) + endif + elseif (segment%gradient) then + segment%normal_vel(i,J,k) = v_new(i,J-1,k) + endif + if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdy <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%normal_vel(i,J,k) = (1.0 - gamma_2) * segment%normal_vel(i,J,k) + & + gamma_2 * segment%nudged_normal_vel(i,J,k) + endif + enddo ; enddo + if (segment%radiation_tan .or. segment%radiation_grad) then + J=segment%HI%JsdB + allocate(ry_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + ry_tang_rad(segment%HI%IsdB,J,k) = segment%ry_norm_rad(segment%HI%isd,J,k) + ry_tang_rad(segment%HI%IedB,J,k) = segment%ry_norm_rad(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + ry_tang_rad(I,J,k) = 0.5*(segment%ry_norm_rad(i,J,k) + segment%ry_norm_rad(i+1,J,k)) + enddo + else + do I=segment%HI%IsdB,segment%HI%IedB + dhdt = u_old(I,j-1,k)-u_new(I,j-1,k) !old-new + dhdy = u_new(I,j-1,k)-u_new(I,j-2,k) !in new time backward sasha for I-1 + ry_tang_rad(I,J,k) = 0.0 + if (dhdt*dhdy > 0.0) ry_tang_rad(I,J,k) = min( (dhdt/dhdy), rx_max) ! outward phase speed + enddo + endif + enddo + if (segment%radiation_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ry_avg = ry_tang_rad(I,J,k) + segment%tangential_vel(I,J,k) = (u_new(I,j,k) + ry_avg*u_new(I,j-1,k)) / (1.0+ry_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%radiation_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=Is_obc,Ie_obc + ry_avg = ry_tang_rad(I,J,k) +! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then +! ry_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * dt * G%IdyBu(I,J-1)) +! elseif (G%mask2dCv(i,J-1) > 0.0) then +! ry_avg = v_new(i,J-1,k) * dt *G%IdyBu(I,J-1) +! elseif (G%mask2dCv(i+1,J-1) > 0.0) then +! ry_avg = v_new(i+1,J-1,k) * dt *G%IdyBu(I,J-1) +! else +! ry_avg = 0.0 +! endif + segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + ry_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+ry_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(ry_tang_rad) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + rx_tang_obl(segment%HI%IsdB,J,k) = segment%rx_norm_obl(segment%HI%isd,J,k) + rx_tang_obl(segment%HI%IedB,J,k) = segment%rx_norm_obl(segment%HI%ied,J,k) + ry_tang_obl(segment%HI%IsdB,J,k) = segment%ry_norm_obl(segment%HI%isd,J,k) + ry_tang_obl(segment%HI%IedB,J,k) = segment%ry_norm_obl(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(i,J,k) + segment%rx_norm_obl(i+1,J,k)) + ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(i,J,k) + segment%ry_norm_obl(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + else + do I=segment%HI%IsdB,segment%HI%IedB + dhdt = u_old(I,j,k)-u_new(I,j,k) !old-new + dhdy = u_new(I,j,k)-u_new(I,j-1,k) !in new time backward sasha for I-1 + if (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) > 0.0) then + dhdx = segment%grad_tan(i,1,k) + elseif (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) == 0.0) then + dhdx = 0.0 + else + dhdx = segment%grad_tan(i+1,1,k) + endif + if (dhdt*dhdy < 0.0) dhdt = 0.0 + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) + rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) + rx_tang_obl(I,j,k) = rx_new + ry_tang_obl(i,J,k) = ry_new + cff_tangential(i,J,k) = cff_new + enddo + endif + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + ry_avg*u_new(I,j-1,k)) - & + (max(rx_avg,0.0)*segment%grad_tan(i,2,k) + & + min(rx_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + ry_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + ry_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + (max(rx_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(rx_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + (cff_avg + ry_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tang_obl) + deallocate(ry_tang_obl) + deallocate(cff_tangential) + endif + endif + + if (segment%direction == OBC_DIRECTION_S) then + J=segment%HI%JsdB + if (J>G%HI%JecB) cycle + do k=1,nz ; do i=segment%HI%isd,segment%HI%ied + if (segment%radiation) then + dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + ry_new = 0.0 + if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) + if (gamma_u < 1.0) then + ry_avg = (1.0-gamma_u)*segment%ry_norm_rad(I,j,k) + gamma_u*ry_new + else + ry_avg = ry_new + endif + segment%ry_norm_rad(i,J,k) = ry_avg + ! The new boundary value is interpolated between future interior + ! value, v_new(J+1) and past boundary value but with barotropic + ! accelerations, v_new(J). + segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) + if (gamma_u < 1.0) then + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%ry_normal(i,J,k) = segment%ry_norm_rad(i,J,k) + endif + elseif (segment%oblique) then + dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then + dhdx = segment%grad_normal(I-1,1,k) + elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then + dhdx = 0.0 + else + dhdx = segment%grad_normal(I,1,k) + endif + if (dhdt*dhdy < 0.0) dhdt = 0.0 + + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) + rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) + if (gamma_u < 1.0) then + rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + else + rx_avg = rx_new + ry_avg = ry_new + cff_avg = cff_new + endif + segment%rx_norm_obl(I,j,k) = rx_avg + segment%ry_norm_obl(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) + if (gamma_u < 1.0) then + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) + endif + elseif (segment%gradient) then + segment%normal_vel(i,J,k) = v_new(i,J+1,k) + endif + if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdy <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%normal_vel(i,J,k) = (1.0 - gamma_2) * segment%normal_vel(i,J,k) + & + gamma_2 * segment%nudged_normal_vel(i,J,k) + endif + enddo ; enddo + if (segment%radiation_tan .or. segment%radiation_grad) then + J=segment%HI%JsdB + allocate(ry_tang_rad(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + ry_tang_rad(segment%HI%IsdB,J,k) = segment%ry_norm_rad(segment%HI%isd,J,k) + ry_tang_rad(segment%HI%IedB,J,k) = segment%ry_norm_rad(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + ry_tang_rad(I,J,k) = 0.5*(segment%ry_norm_rad(i,J,k) + segment%ry_norm_rad(i+1,J,k)) + enddo + else + do I=segment%HI%IsdB,segment%HI%IedB + dhdt = u_old(I,j+1,k)-u_new(I,j+1,k) !old-new + dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sasha for I-1 + ry_tang_rad(I,J,k) = 0.0 + if (dhdt*dhdy > 0.0) ry_tang_rad(I,J,k) = min( (dhdt/dhdy), rx_max) ! outward phase speed + enddo + endif + enddo + if (segment%radiation_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ry_avg = ry_tang_rad(I,J,k) + segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + ry_avg*u_new(I,j+2,k)) / (1.0+ry_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%radiation_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=Is_obc,Ie_obc + ry_avg = ry_tang_rad(I,J,k) +! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then +! ry_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * dt * G%IdyBu(I,J+1) +! elseif (G%mask2dCv(i,J+1) > 0.0) then +! ry_avg = v_new(i,J+1,k) * dt * G%IdyBu(I,J+1) +! elseif (G%mask2dCv(i+1,J+1) > 0.0) then +! ry_avg = v_new(i+1,J+1,k) * dt * G%IdyBu(I,J+1) +! else +! ry_avg = 0.0 +! endif + segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + ry_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+ry_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_rad(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(ry_tang_rad) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tang_obl(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + if (gamma_u < 1.0) then + rx_tang_obl(segment%HI%IsdB,J,k) = segment%rx_norm_obl(segment%HI%isd,J,k) + rx_tang_obl(segment%HI%IedB,J,k) = segment%rx_norm_obl(segment%HI%ied,J,k) + ry_tang_obl(segment%HI%IsdB,J,k) = segment%ry_norm_obl(segment%HI%isd,J,k) + ry_tang_obl(segment%HI%IedB,J,k) = segment%ry_norm_obl(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tang_obl(I,J,k) = 0.5*(segment%rx_norm_obl(i,J,k) + segment%rx_norm_obl(i+1,J,k)) + ry_tang_obl(I,J,k) = 0.5*(segment%ry_norm_obl(i,J,k) + segment%ry_norm_obl(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + else + do I=segment%HI%IsdB,segment%HI%IedB + dhdt = u_old(I,j+1,k)-u_new(I,j+1,k) !old-new + dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sasha for I-1 + if (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) > 0.0) then + dhdx = segment%grad_tan(i,1,k) + elseif (dhdt*(segment%grad_tan(i,1,k) + segment%grad_tan(i+1,1,k)) == 0.0) then + dhdx = 0.0 + else + dhdx = segment%grad_tan(i+1,1,k) + endif + if (dhdt*dhdy < 0.0) dhdt = 0.0 + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) + rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) + rx_tang_obl(I,j,k) = rx_new + ry_tang_obl(i,J,k) = ry_new + cff_tangential(i,J,k) = cff_new + enddo + endif + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + ry_avg*u_new(I,j+2,k)) - & + (max(rx_avg,0.0)*segment%grad_tan(i,2,k) + & + min(rx_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + (cff_avg + ry_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1.0 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tang_obl(I,J,k) + ry_avg = ry_tang_obl(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + ry_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + (max(rx_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(rx_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (cff_avg + ry_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tang_obl(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1.0 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tang_obl) + deallocate(ry_tang_obl) + deallocate(cff_tangential) + endif + endif enddo ! Actually update u_new, v_new - call open_boundary_apply_normal_flow(OBC, G, u_new, v_new) + call open_boundary_apply_normal_flow(OBC, G, GV, u_new, v_new) call pass_vector(u_new, v_new, G%Domain, clock=id_clock_pass) end subroutine radiation_open_bdry_conds !> 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), 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 + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< v field to update on open !! boundaries [L T-1 ~> m s-1] ! Local variables integer :: i, j, k, n @@ -3243,12 +3246,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 @@ -3258,12 +3261,13 @@ 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 - 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 + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< u field to update on open boundaries + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< v field to update on open boundaries ! Local variables integer :: i, j, k, n type(OBC_segment_type), pointer :: segment => NULL() @@ -3276,12 +3280,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 @@ -3290,11 +3294,12 @@ 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 - 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] +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_(GV)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k if (.not. segment%on_pe) return @@ -3302,14 +3307,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) @@ -3317,7 +3322,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) @@ -3328,14 +3333,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) @@ -3343,7 +3348,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) @@ -3356,14 +3361,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) @@ -3371,7 +3376,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) @@ -3382,14 +3387,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) @@ -3397,7 +3402,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) @@ -3414,11 +3419,12 @@ 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness type(param_file_type), intent(in) :: PF !< Parameter file handle type(tracer_registry_type), pointer :: tracer_Reg !< Tracer registry ! Local variables @@ -3432,7 +3438,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 @@ -3451,22 +3457,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 @@ -3483,12 +3489,12 @@ function lookup_seg_field(OBC_seg,field) ! Local variables integer :: n - lookup_seg_field=-1 + lookup_seg_field = -1 do n=1,OBC_seg%num_fields - if (trim(field) == OBC_seg%field(n)%name) then - lookup_seg_field=n - return - endif + if (trim(field) == OBC_seg%field(n)%name) then + lookup_seg_field = n + return + endif enddo end function lookup_seg_field @@ -3638,18 +3644,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 @@ -3731,7 +3738,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness [H ~> m or kg m-2] type(time_type), intent(in) :: Time !< Model time ! Local variables integer :: c, i, j, k, is, ie, js, je, isd, ied, jsd, jed @@ -3760,7 +3767,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 @@ -3800,7 +3807,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 @@ -3813,14 +3820,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 @@ -3832,25 +3839,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 @@ -4035,19 +4042,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 @@ -4062,7 +4069,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 @@ -4081,19 +4088,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 @@ -4108,7 +4115,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 @@ -4127,37 +4134,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 @@ -4182,7 +4189,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) @@ -4203,7 +4210,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) @@ -4225,7 +4232,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)) & @@ -4243,7 +4250,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)) & @@ -4254,7 +4261,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,:) @@ -4264,7 +4271,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,:) @@ -4326,12 +4333,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (trim(segment%field(m)%name) == 'TEMP') then if (associated(segment%field(m)%buffer_dst)) then - do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(1)%is_initialized) then ! if the tracer reservoir has not yet been initialized, then set to external value. - do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%tres(i,j,k) = segment%tr_Reg%Tr(1)%t(i,j,k) enddo ; enddo ; enddo segment%tr_Reg%Tr(1)%is_initialized=.true. @@ -4341,12 +4348,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif elseif (trim(segment%field(m)%name) == 'SALT') then if (associated(segment%field(m)%buffer_dst)) then - do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(2)%is_initialized) then !if the tracer reservoir has not yet been initialized, then set to external value. - do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%tres(i,j,k) = segment%tr_Reg%Tr(2)%t(i,j,k) enddo ; enddo ; enddo segment%tr_Reg%Tr(2)%is_initialized=.true. @@ -4630,8 +4637,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 @@ -4647,7 +4655,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) @@ -4686,7 +4694,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 @@ -5051,17 +5059,17 @@ end subroutine open_boundary_register_restarts !> Update the OBC tracer reservoirs after the tracers have been updated. subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhr !< accumulated volume/mass flux through - !! the zonal face [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhr !< accumulated volume/mass flux through - !! the meridional face [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness after advection - !! [H ~> m or kg m-2] - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - real, intent(in) :: dt !< time increment [T ~> s] - type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: uhr !< accumulated volume/mass flux through + !! the zonal face [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vhr !< accumulated volume/mass flux through + !! the meridional face [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness after advection + !! [H ~> m or kg m-2] + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + real, intent(in) :: dt !< time increment [T ~> s] + type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry ! Local variables type(OBC_segment_type), pointer :: segment=>NULL() real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell [L ~> m] @@ -5157,12 +5165,12 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) nz = size(segment%field(fld)%dz_src,3) if (segment%is_E_or_W) then - ! segment thicknesses are defined at cell face centers. - is = segment%HI%isdB ; ie = segment%HI%iedB - js = segment%HI%jsd ; je = segment%HI%jed + ! segment thicknesses are defined at cell face centers. + is = segment%HI%isdB ; ie = segment%HI%iedB + js = segment%HI%jsd ; je = segment%HI%jed else - is = segment%HI%isd ; ie = segment%HI%ied - js = segment%HI%jsdB ; je = segment%HI%jedB + is = segment%HI%isd ; ie = segment%HI%ied + js = segment%HI%jsdB ; je = segment%HI%jedB endif allocate(eta(is:ie,js:je,nz+1)) contractions=0; dilations=0 @@ -5215,7 +5223,7 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) do k=1,nz segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k)*GV%Z_to_H enddo - enddo; enddo + enddo ; enddo ! can not do communication call here since only PEs on the current segment are here @@ -5307,8 +5315,8 @@ subroutine rotate_OBC_config(OBC_in, G_in, OBC, G, turns) ! remap_CS is set up by initialize_segment_data, so we copy the fields here. if (ASSOCIATED(OBC_in%remap_CS)) then - allocate(OBC%remap_CS) - OBC%remap_CS = OBC_in%remap_CS + allocate(OBC%remap_CS) + OBC%remap_CS = OBC_in%remap_CS endif ! TODO: The OBC registry seems to be a list of "registered" OBC types. @@ -5473,7 +5481,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 5c0a751b55..2cfce980dc 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 @@ -475,14 +476,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, & @@ -504,8 +506,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 091f88fac2..303809ac06 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -71,9 +71,9 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp 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(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: um !< The new zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. @@ -85,9 +85,9 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step divided by the Boussinesq density [m2 s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. ! Local variables @@ -95,13 +95,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp real :: Angstrom real :: truncvel, du real :: dt ! The time step [s] - real :: Inorm(SZK_(G)) - real :: e(SZK_(G)+1) + real :: Inorm(SZK_(GV)) + real :: e(SZK_(GV)+1) real :: h_scale, uh_scale integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz - logical :: do_k(SZK_(G)+1) + logical :: do_k(SZK_(GV)+1) logical :: prev_avail integer :: file @@ -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 @@ -404,9 +404,9 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp 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),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: vm !< The new meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. @@ -418,9 +418,9 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step divided by the Boussinesq density [m2 s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. ! Local variables @@ -428,13 +428,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp real :: Angstrom real :: truncvel, dv real :: dt ! The time step [s] - real :: Inorm(SZK_(G)) - real :: e(SZK_(G)+1) + real :: Inorm(SZK_(GV)) + real :: e(SZK_(GV)+1) real :: h_scale, uh_scale integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz - logical :: do_k(SZK_(G)+1) + logical :: do_k(SZK_(GV)+1) logical :: prev_avail integer :: file @@ -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_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 43c9c8c406..fda5a97d69 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -459,8 +459,8 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & array(i,j), a_nonsym(i,j),array(i,j)-a_nonsym(i,j),i,j,pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) - redundant_prints(1) = redundant_prints(1) + 1 - endif + redundant_prints(1) = redundant_prints(1) + 1 + endif enddo ; enddo end subroutine check_redundant_sT2d diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index b8830faa17..e0dc3c95d4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -200,16 +200,16 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: uh !< Transport through zonal faces = u*h*dy, !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: vh !< Transport through meridional faces = v*h*dx, !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -240,8 +240,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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, nkmb - real :: Rcv(SZI_(G),SZJ_(G),SZK_(G)) ! Coordinate variable potential density [R ~> kg m-3]. - real :: work_3d(SZI_(G),SZJ_(G),SZK_(G)) ! A 3-d temporary work array. + real :: Rcv(SZI_(G),SZJ_(G),SZK_(GV)) ! Coordinate variable potential density [R ~> kg m-3]. + real :: work_3d(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary work array. real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] @@ -259,12 +259,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & integer :: k_list - real, dimension(SZK_(G)) :: temp_layer_ave, salt_layer_ave + real, dimension(SZK_(GV)) :: temp_layer_ave, salt_layer_ave real :: thetaoga, soga, masso, tosga, sosga 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 @@ -388,7 +388,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! mass per area of grid cell (for Bouss, use Rho0) if (CS%id_masscello > 0) then - do k=1,nz; do j=js,je ; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_kg_m2*h(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_masscello, work_3d, CS%diag) @@ -410,13 +410,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_thkcello > 0) then ; if (GV%H_to_Z == 1.0) then call post_data(CS%id_thkcello, h, CS%diag) else - do k=1,nz; do j=js,je ; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_Z*h(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_thkcello, work_3d, CS%diag) endif ; endif if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq - do k=1,nz; do j=js,je ; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = ( GV%H_to_Z*h(i,j,k) ) * US%Z_to_m*US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) @@ -450,7 +450,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo ! j if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, work_3d, CS%diag) if (CS%id_volcello > 0) then - do k=1,nz; do j=js,je ; do i=is,ie ! volcello = dp/(rho*g)*area for non-Boussinesq + do k=1,nz ; do j=js,je ; do i=is,ie ! volcello = dp/(rho*g)*area for non-Boussinesq work_3d(i,j,k) = US%Z_to_m*US%L_to_m**2*G%areaT(i,j) * work_3d(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) @@ -862,7 +862,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -889,7 +889,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 @@ -978,16 +978,16 @@ end subroutine calculate_vertical_integrals subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: uh !< Transport through zonal faces=u*h*dy, !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: vh !< Transport through merid faces=v*h*dx, !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation. @@ -1004,7 +1004,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 @@ -1455,11 +1455,11 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes !! used to advect tracers [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes !! used to advect tracers [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< The updated layer thicknesses [H ~> m or kg m-2] type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(diag_grid_storage), intent(inout) :: diag_pre_dyn !< Stored grids from before dynamics @@ -1470,15 +1470,15 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy ! Local variables real, dimension(SZIB_(G), SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] real, dimension(SZI_(G), SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)) :: umo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZI_(G), SZJB_(G), SZK_(G)) :: vmo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tend ! Change in layer thickness due to dynamics + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)) :: umo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)) :: vmo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tend ! Change in layer thickness due to dynamics ! [H s-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [T-1 ~> s-1] 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 @@ -1574,7 +1574,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 @@ -1929,7 +1929,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 @@ -2237,7 +2237,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. @@ -2246,12 +2246,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 279faa05c4..03204e4322 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] @@ -203,7 +204,7 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & !query fms_io if there is a filename_appendix (for ensemble runs) call get_filename_appendix(filename_appendix) if (len_trim(filename_appendix) > 0) then - energyfile = trim(energyfile) //'.'//trim(filename_appendix) + energyfile = trim(energyfile) //'.'//trim(filename_appendix) endif CS%energyfile = trim(slasher(directory))//trim(energyfile) @@ -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 @@ -298,11 +299,11 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ 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(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -317,22 +318,22 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ optional, pointer :: OBC !< Open boundaries control structure. type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces [Z ~> m]. + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! The height of interfaces [Z ~> m]. real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT [L2 ~> m2]. - real :: KE(SZK_(G)) ! The total kinetic energy of a layer [J]. - real :: PE(SZK_(G)+1)! The available potential energy of an interface [J]. + real :: KE(SZK_(GV)) ! The total kinetic energy of a layer [J]. + real :: PE(SZK_(GV)+1)! The available potential energy of an interface [J]. real :: KE_tot ! The total kinetic energy [J]. real :: PE_tot ! The total available potential energy [J]. - real :: Z_0APE(SZK_(G)+1) ! The uniform depth which overlies the same + real :: Z_0APE(SZK_(GV)+1) ! The uniform depth which overlies the same ! volume as is below an interface [Z ~> m]. - real :: H_0APE(SZK_(G)+1) ! A version of Z_0APE, converted to m, usually positive. + real :: H_0APE(SZK_(GV)+1) ! A version of Z_0APE, converted to m, usually positive. real :: toten ! The total kinetic & potential energies of ! all layers [J] (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by ! the total mass of the ocean [m2 s-2]. - real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer [Z L2 ~> m3]. + real :: vol_lay(SZK_(GV)) ! The volume of fluid in a layer [Z L2 ~> m3]. real :: volbelow ! The volume of all layers beneath an interface [Z L2 ~> m3]. - real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer [kg]. + real :: mass_lay(SZK_(GV)) ! The mass of fluid in a layer [kg]. real :: mass_tot ! The total mass of the ocean [kg]. real :: vol_tot ! The total ocean volume [m3]. real :: mass_chg ! The change in total ocean mass of fresh water since @@ -382,9 +383,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real :: CFL_lin ! A simpler definition of the CFL number [nondim]. real :: max_CFL(2) ! The maxima of the CFL numbers [nondim]. real :: Irho0 ! The inverse of the reference density [m3 kg-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & tmp1 ! A temporary array - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & PE_pt ! The potential energy at each point [J]. real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. @@ -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 @@ -1297,7 +1299,7 @@ subroutine write_depth_list(G, US, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) status = NF90_PUT_ATT(ncid, Vid, "long_name", "Open volume below depth") - if (status /= NF90_NOERR) call MOM_error(WARNING, & + if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) status = NF90_PUT_ATT(ncid, Vid, "units", "m3") if (status /= NF90_NOERR) call MOM_error(WARNING, & diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 8b50fe1acb..035386f92d 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -59,7 +59,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed [L T-1 ~> m s-1] @@ -74,7 +74,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical !! modal structure [Z ~> m]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: modal_structure !< Normalized model structure [nondim] logical, optional, intent(in) :: better_speed_est !< If true, use a more robust estimate of the first !! mode speed as the starting point for iterations. @@ -84,7 +84,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !! wave speeds [nondim] ! Local variables - real, dimension(SZK_(G)+1) :: & + real, dimension(SZK_(GV)+1) :: & dRho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] dRho_dS, & ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] pres, & ! Interface pressure [R L2 T-2 ~> Pa] @@ -93,15 +93,15 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m] H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m] gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. - real, dimension(SZK_(G)) :: & + real, dimension(SZK_(GV)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, in [T2 L-2 ~> s2 m-2]. - real, dimension(SZK_(G),SZI_(G)) :: & + real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] Tf, & ! Layer temperatures after very thin layers are combined [degC] Sf, & ! Layer salinities after very thin layers are combined [ppt] Rf ! Layer densities after very thin layers are combined [R ~> kg m-3] - real, dimension(SZK_(G)) :: & + real, dimension(SZK_(GV)) :: & Hc, & ! A column of layer thicknesses after convective istabilities are removed [Z ~> m] Tc, & ! A column of layer temperatures after convective istabilities are removed [degC] Sc, & ! A column of layer salinites after convective istabilities are removed [ppt] @@ -149,9 +149,9 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: N2min ! A minimum buoyancy frequency [T-2 ~> s-2] logical :: l_use_ebt_mode, calc_modal_structure real :: l_mono_N2_column_fraction, l_mono_N2_depth - real :: mode_struct(SZK_(G)), ms_min, ms_max, ms_sq + real :: mode_struct(SZK_(GV)), 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.") @@ -170,7 +170,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ calc_modal_structure = l_use_ebt_mode if (present(modal_structure)) calc_modal_structure = .true. if (calc_modal_structure) then - do k=1,nz; do j=js,je; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie modal_structure(i,j,k) = 0.0 enddo ; enddo ; enddo endif @@ -642,7 +642,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] @@ -657,7 +657,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee !! wave speeds [nondim] ! Local variables - real, dimension(SZK_(G)+1) :: & + real, dimension(SZK_(GV)+1) :: & dRho_dT, & ! Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] dRho_dS, & ! Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] pres, & ! Interface pressure [R L2 T-2 ~> Pa] @@ -666,12 +666,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m] H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m] gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. - real, dimension(SZK_(G),SZI_(G)) :: & + real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] Tf, & ! Layer temperatures after very thin layers are combined [degC] Sf, & ! Layer salinities after very thin layers are combined [ppt] Rf ! Layer densities after very thin layers are combined [R ~> kg m-3] - real, dimension(SZK_(G)) :: & + real, dimension(SZK_(GV)) :: & Igl, Igu, & ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, in [T2 L-2 ~> s2 m-2]. Hc, & ! A column of layer thicknesses after convective istabilities are removed [Z ~> m] @@ -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 05494fb819..a3e60cf584 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -95,7 +95,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - 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_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal @@ -109,26 +109,26 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. ! Local variables - real, dimension(SZK_(G)+1) :: & + real, dimension(SZK_(GV)+1) :: & dRho_dT, & !< Partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] dRho_dS, & !< Partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1] pres, & !< Interface pressure [R L H T-2 ~> Pa] T_int, & !< Temperature interpolated to interfaces [degC] S_int, & !< Salinity interpolated to interfaces [ppt] gprime !< The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. - real, dimension(SZK_(G)) :: & + real, dimension(SZK_(GV)) :: & Igl, Igu !< The inverse of the reduced gravity across an interface times !< the thickness of the layer below (Igl) or above (Igu) it [T2 L-2 ~> s2 m-2]. - real, dimension(SZK_(G),SZI_(G)) :: & + real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & !< Layer thicknesses after very thin layers are combined [Z ~> m] Tf, & !< Layer temperatures after very thin layers are combined [degC] Sf, & !< Layer salinities after very thin layers are combined [ppt] Rf !< Layer densities after very thin layers are combined [R ~> kg m-3] - real, dimension(SZK_(G)) :: & - Hc, & !< A column of layer thicknesses after convective istabilities are removed [Z ~> m] - Tc, & !< A column of layer temperatures after convective istabilities are removed [degC] - Sc, & !< A column of layer salinites after convective istabilities are removed [ppt] - Rc, & !< A column of layer densities after convective istabilities are removed [R ~> kg m-3] + real, dimension(SZK_(GV)) :: & + Hc, & !< A column of layer thicknesses after convective instabilities are removed [Z ~> m] + Tc, & !< A column of layer temperatures after convective instabilities are removed [degC] + Sc, & !< A column of layer salinites after convective instabilities are removed [ppt] + Rc, & !< A column of layer densities after convective instabilities are removed [R ~> kg m-3] det, ddet real, dimension(SZI_(G),SZJ_(G)) :: & htot !< The vertical sum of the thicknesses [Z ~> m] @@ -160,37 +160,37 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! local representations of variables in CS; note, ! not all rows will be filled if layers get merged! - real, dimension(SZK_(G)+1) :: w_strct !< Vertical structure of vertical velocity (normalized) [nondim]. - real, dimension(SZK_(G)+1) :: u_strct !< Vertical structure of horizontal velocity (normalized) [nondim]. - real, dimension(SZK_(G)+1) :: W_profile !< Vertical profile of w_hat(z) = W0*w_strct(z) [Z T-1 ~> m s-1]. - real, dimension(SZK_(G)+1) :: Uavg_profile !< Vertical profile of the magnitude of + real, dimension(SZK_(GV)+1) :: w_strct !< Vertical structure of vertical velocity (normalized) [nondim]. + real, dimension(SZK_(GV)+1) :: u_strct !< Vertical structure of horizontal velocity (normalized) [nondim]. + real, dimension(SZK_(GV)+1) :: W_profile !< Vertical profile of w_hat(z) = W0*w_strct(z) [Z T-1 ~> m s-1]. + real, dimension(SZK_(GV)+1) :: Uavg_profile !< Vertical profile of the magnitude of !! horizontal velocity [L T-1 ~> m s-1]. - real, dimension(SZK_(G)+1) :: z_int !< Integrated depth [Z ~> m] - real, dimension(SZK_(G)+1) :: N2 !< Squared buoyancy frequency at each interface [T-2 ~> s-2]. - real, dimension(SZK_(G)+1) :: w_strct2 !< squared values [nondim] - real, dimension(SZK_(G)+1) :: u_strct2 !< squared values [nondim] - real, dimension(SZK_(G)) :: dz !< thicknesses of merged layers (same as Hc I hope) [Z ~> m] - ! real, dimension(SZK_(G)+1) :: dWdz_profile !< profile of dW/dz - real :: w2avg !< average of squared vertical velocity structure funtion [Z ~> m] - real :: int_dwdz2 - real :: int_w2 - real :: int_N2w2 - real :: KE_term !< terms in vertically averaged energy equation - real :: PE_term !< terms in vertically averaged energy equation - real :: W0 !< A vertical velocity magnitude [Z T-1 ~> m s-1] - real :: gp_unscaled !< A version of gprime rescaled to [L T-2 ~> m s-2]. - real, dimension(SZK_(G)-1) :: lam_z !< product of eigen value and gprime(k); one value for each - !< interface (excluding surface and bottom) - real, dimension(SZK_(G)-1) :: a_diag, b_diag, c_diag - !< diagonals of tridiagonal matrix; one value for each - !< interface (excluding surface and bottom) - real, dimension(SZK_(G)-1) :: e_guess !< guess at eigen vector with unit amplitde (for TDMA) - real, dimension(SZK_(G)-1) :: e_itt !< improved guess at eigen vector (from TDMA) + real, dimension(SZK_(GV)+1) :: z_int !< Integrated depth [Z ~> m] + real, dimension(SZK_(GV)+1) :: N2 !< Squared buoyancy frequency at each interface [T-2 ~> s-2]. + real, dimension(SZK_(GV)+1) :: w_strct2 !< squared values [nondim] + real, dimension(SZK_(GV)+1) :: u_strct2 !< squared values [nondim] + real, dimension(SZK_(GV)) :: dz !< thicknesses of merged layers (same as Hc I hope) [Z ~> m] + ! real, dimension(SZK_(GV)+1) :: dWdz_profile !< profile of dW/dz + real :: w2avg !< average of squared vertical velocity structure funtion [Z ~> m] + real :: int_dwdz2 + real :: int_w2 + real :: int_N2w2 + real :: KE_term !< terms in vertically averaged energy equation + real :: PE_term !< terms in vertically averaged energy equation + real :: W0 !< A vertical velocity magnitude [Z T-1 ~> m s-1] + real :: gp_unscaled !< A version of gprime rescaled to [L T-2 ~> m s-2]. + real, dimension(SZK_(GV)-1) :: lam_z !< product of eigen value and gprime(k); one value for each + !< interface (excluding surface and bottom) + real, dimension(SZK_(GV)-1) :: a_diag, b_diag, c_diag + !< diagonals of tridiagonal matrix; one value for each + !< interface (excluding surface and bottom) + real, dimension(SZK_(GV)-1) :: e_guess !< guess at eigen vector with unit amplitde (for TDMA) + real, dimension(SZK_(GV)-1) :: e_itt !< improved guess at eigen vector (from TDMA) real :: Pi 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 @@ -719,9 +719,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 @@ -733,7 +734,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/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 3d2b9dd3e9..6e74c3ffa3 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1550,12 +1550,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) do k=1,kd ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec if (mask_z(i,j,k) >= 1.0) then - S(i,j,k) = gsw_sr_from_sp(S(i,j,k)) + S(i,j,k) = gsw_sr_from_sp(S(i,j,k)) ! Get absolute salinity from practical salinity, converting pressures from Pascal to dbar. ! If this option is activated, pressure will need to be added as an argument, and it should be ! moved out into module that is not shared between components, where the ocean_grid can be used. ! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),pres(i,j,k)*1.0e-4,G%geoLonT(i,j),G%geoLatT(i,j)) - T(i,j,k) = gsw_ct_from_pt(S(i,j,k), T(i,j,k)) + T(i,j,k) = gsw_ct_from_pt(S(i,j,k), T(i,j,k)) endif enddo ; enddo ; enddo end subroutine convert_temp_salt_for_TEOS10 diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 644a9fa43c..c3174dbe7b 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -413,7 +413,7 @@ integer function subchk(array, HI, di, dj, scale) real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, bc subchk = 0 - do j=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di + do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(i,j))) subchk = subchk + bc enddo ; enddo @@ -693,7 +693,7 @@ integer function subchk(array, HI, di, dj, scale) integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. - do J=HI%jsc+dj,HI%jec+dj; do I=HI%isc+di,HI%iec+di + do J=HI%jsc+dj,HI%jec+dj ; do I=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(I,J))) subchk = subchk + bc enddo ; enddo @@ -983,7 +983,7 @@ integer function subchk(array, HI, di, dj, scale) integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. - do j=HI%jsc+dj,HI%jec+dj; do I=HI%isc+di,HI%iec+di + do j=HI%jsc+dj,HI%jec+dj ; do I=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(I,j))) subchk = subchk + bc enddo ; enddo @@ -1162,7 +1162,7 @@ integer function subchk(array, HI, di, dj, scale) integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. - do J=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di + do J=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(i,J))) subchk = subchk + bc enddo ; enddo diff --git a/src/framework/MOM_diag_manager_wrapper.F90 b/src/framework/MOM_diag_manager_wrapper.F90 index 709fd80a8e..47dc701798 100644 --- a/src/framework/MOM_diag_manager_wrapper.F90 +++ b/src/framework/MOM_diag_manager_wrapper.F90 @@ -19,8 +19,8 @@ module MOM_diag_manager_wrapper !> An integer handle for a diagnostic array returned by register_diag_field() integer function register_diag_field_array_fms(module_name, field_name, axes, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or !! "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -55,8 +55,8 @@ end function register_diag_field_array_fms !> An integer handle for a diagnostic scalar array returned by register_diag_field() integer function register_diag_field_scalar_fms(module_name, field_name, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e04234c859..fa4a4a2701 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -73,23 +73,23 @@ module MOM_diag_mediator !> Down sample a field interface downsample_field - module procedure downsample_field_2d, downsample_field_3d + module procedure downsample_field_2d, downsample_field_3d end interface downsample_field !> Down sample the mask of a field interface downsample_mask - module procedure downsample_mask_2d, downsample_mask_3d + module procedure downsample_mask_2d, downsample_mask_3d end interface downsample_mask !> Down sample a diagnostic field interface downsample_diag_field - module procedure downsample_diag_field_2d, downsample_diag_field_3d + module procedure downsample_diag_field_2d, downsample_diag_field_3d end interface downsample_diag_field !> Contained for down sampled masks type, private :: diag_dsamp - real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes - real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes + real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes + real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes end type diag_dsamp !> A group of 1D axes that comprise a 1D/2D/3D mesh @@ -367,62 +367,61 @@ subroutine set_axes_info(G, GV, US, param_file, diag_cs, set_vertical) if (diag_cs%grid_space_axes) then - allocate(IaxB(G%IsgB:G%IegB)) - do i=G%IsgB, G%IegB - Iaxb(i)=real(i) - enddo - allocate(iax(G%isg:G%ieg)) - do i=G%isg, G%ieg - iax(i)=real(i)-0.5 - enddo - allocate(JaxB(G%JsgB:G%JegB)) - do j=G%JsgB, G%JegB - JaxB(j)=real(j) - enddo - allocate(jax(G%jsg:G%jeg)) - do j=G%jsg, G%jeg - jax(j)=real(j)-0.5 - enddo + allocate(IaxB(G%IsgB:G%IegB)) + do i=G%IsgB, G%IegB + Iaxb(i)=real(i) + enddo + allocate(iax(G%isg:G%ieg)) + do i=G%isg, G%ieg + iax(i)=real(i)-0.5 + enddo + allocate(JaxB(G%JsgB:G%JegB)) + do j=G%JsgB, G%JegB + JaxB(j)=real(j) + enddo + allocate(jax(G%jsg:G%jeg)) + do j=G%jsg, G%jeg + jax(j)=real(j)-0.5 + enddo endif ! Horizontal axes for the native grids if (G%symmetric) then - if (diag_cs%grid_space_axes) then - id_xq = diag_axis_init('iq', IaxB(G%isgB:G%iegB), 'none', 'x', & - 'q point grid-space longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) - id_yq = diag_axis_init('jq', JaxB(G%jsgB:G%jegB), 'none', 'y', & - 'q point grid space latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) - else - id_xq = diag_axis_init('xq', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) - id_yq = diag_axis_init('yq', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) - endif + if (diag_cs%grid_space_axes) then + id_xq = diag_axis_init('iq', IaxB(G%isgB:G%iegB), 'none', 'x', & + 'q point grid-space longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) + id_yq = diag_axis_init('jq', JaxB(G%jsgB:G%jegB), 'none', 'y', & + 'q point grid space latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) + else + id_xq = diag_axis_init('xq', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) + id_yq = diag_axis_init('yq', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) + endif else - if (diag_cs%grid_space_axes) then - id_xq = diag_axis_init('Iq', IaxB(G%isg:G%ieg), 'none', 'x', & - 'q point grid-space longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) - id_yq = diag_axis_init('Jq', JaxB(G%jsg:G%jeg), 'none', 'y', & - 'q point grid space latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) - else - id_xq = diag_axis_init('xq', G%gridLonB(G%isg:G%ieg), G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) - id_yq = diag_axis_init('yq', G%gridLatB(G%jsg:G%jeg), G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) - endif + if (diag_cs%grid_space_axes) then + id_xq = diag_axis_init('Iq', IaxB(G%isg:G%ieg), 'none', 'x', & + 'q point grid-space longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) + id_yq = diag_axis_init('Jq', JaxB(G%jsg:G%jeg), 'none', 'y', & + 'q point grid space latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) + else + id_xq = diag_axis_init('xq', G%gridLonB(G%isg:G%ieg), G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) + id_yq = diag_axis_init('yq', G%gridLatB(G%jsg:G%jeg), G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) + endif endif - if (diag_cs%grid_space_axes) then - id_xh = diag_axis_init('ih', iax(G%isg:G%ieg), 'none', 'x', & - 'h point grid-space longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) - id_yh = diag_axis_init('jh', jax(G%jsg:G%jeg), 'none', 'y', & - 'h point grid space latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) + id_xh = diag_axis_init('ih', iax(G%isg:G%ieg), 'none', 'x', & + 'h point grid-space longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) + id_yh = diag_axis_init('jh', jax(G%jsg:G%jeg), 'none', 'y', & + 'h point grid space latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) else - id_xh = diag_axis_init('xh', G%gridLonT(G%isg:G%ieg), G%x_axis_units, 'x', & - 'h point nominal longitude', Domain2=G%Domain%mpp_domain) - id_yh = diag_axis_init('yh', G%gridLatT(G%jsg:G%jeg), G%y_axis_units, 'y', & - 'h point nominal latitude', Domain2=G%Domain%mpp_domain) + id_xh = diag_axis_init('xh', G%gridLonT(G%isg:G%ieg), G%x_axis_units, 'x', & + 'h point nominal longitude', Domain2=G%Domain%mpp_domain) + id_yh = diag_axis_init('yh', G%gridLatT(G%jsg:G%jeg), G%y_axis_units, 'y', & + 'h point nominal latitude', Domain2=G%Domain%mpp_domain) endif if (set_vert) then @@ -578,12 +577,12 @@ subroutine set_axes_info(G, GV, US, param_file, diag_cs, set_vertical) enddo if (diag_cs%grid_space_axes) then - deallocate(IaxB,iax,JaxB,jax) + deallocate(IaxB, iax, JaxB, jax) endif !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 @@ -606,153 +605,153 @@ subroutine set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_n id_zl = id_zl_native ; id_zi = id_zi_native !Axes group for native downsampled diagnostics do dl=2,MAX_DSAMP_LEV - if (dl /= 2) call MOM_error(FATAL, "set_axes_info_dsamp: Downsample level other than 2 is not supported yet!") - if (G%symmetric) then - allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isgB:diag_cs%dsamp(dl)%iegB)) - allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsgB:diag_cs%dsamp(dl)%jegB)) - do i=diag_cs%dsamp(dl)%isgB,diag_cs%dsamp(dl)%iegB; gridLonB_dsamp(i) = G%gridLonB(G%isgB+dl*i); enddo - do j=diag_cs%dsamp(dl)%jsgB,diag_cs%dsamp(dl)%jegB; gridLatB_dsamp(j) = G%gridLatB(G%jsgB+dl*j); enddo - id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) - id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) - deallocate(gridLonB_dsamp,gridLatB_dsamp) - else - allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) - allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) - do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonB_dsamp(i) = G%gridLonB(G%isg+dl*i-2); enddo - do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatB_dsamp(j) = G%gridLatB(G%jsg+dl*j-2); enddo - id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) - id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) - deallocate(gridLonB_dsamp,gridLatB_dsamp) - endif - - allocate(gridLonT_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) - allocate(gridLatT_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) - do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonT_dsamp(i) = G%gridLonT(G%isg+dl*i-2); enddo - do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatT_dsamp(j) = G%gridLatT(G%jsg+dl*j-2); enddo - id_xh = diag_axis_init('xh', gridLonT_dsamp, G%x_axis_units, 'x', & + if (dl /= 2) call MOM_error(FATAL, "set_axes_info_dsamp: Downsample level other than 2 is not supported yet!") + if (G%symmetric) then + allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isgB:diag_cs%dsamp(dl)%iegB)) + allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsgB:diag_cs%dsamp(dl)%jegB)) + do i=diag_cs%dsamp(dl)%isgB,diag_cs%dsamp(dl)%iegB; gridLonB_dsamp(i) = G%gridLonB(G%isgB+dl*i); enddo + do j=diag_cs%dsamp(dl)%jsgB,diag_cs%dsamp(dl)%jegB; gridLatB_dsamp(j) = G%gridLatB(G%jsgB+dl*j); enddo + id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) + deallocate(gridLonB_dsamp,gridLatB_dsamp) + else + allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) + allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) + do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonB_dsamp(i) = G%gridLonB(G%isg+dl*i-2); enddo + do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatB_dsamp(j) = G%gridLatB(G%jsg+dl*j-2); enddo + id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) + deallocate(gridLonB_dsamp,gridLatB_dsamp) + endif + + allocate(gridLonT_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) + allocate(gridLatT_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) + do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonT_dsamp(i) = G%gridLonT(G%isg+dl*i-2); enddo + do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatT_dsamp(j) = G%gridLatT(G%jsg+dl*j-2); enddo + id_xh = diag_axis_init('xh', gridLonT_dsamp, G%x_axis_units, 'x', & 'h point nominal longitude', Domain2=G%Domain%mpp_domain_d2) - id_yh = diag_axis_init('yh', gridLatT_dsamp, G%y_axis_units, 'y', & + id_yh = diag_axis_init('yh', gridLatT_dsamp, G%y_axis_units, 'y', & 'h point nominal latitude', Domain2=G%Domain%mpp_domain_d2) - deallocate(gridLonT_dsamp,gridLatT_dsamp) - - ! Axis groupings for the model layers - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%axesTL, dl, & - x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & - is_h_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%dsamp(dl)%axesBL, dl, & - x_cell_method='point', y_cell_method='point', v_cell_method='mean', & - is_q_point=.true., is_layer=.true.) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%dsamp(dl)%axesCuL, dl, & - x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & - is_u_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%dsamp(dl)%axesCvL, dl, & - x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & - is_v_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - - ! Axis groupings for the model interfaces - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%dsamp(dl)%axesTi, dl, & - x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & - is_h_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%dsamp(dl)%axesBi, dl, & - x_cell_method='point', y_cell_method='point', v_cell_method='point', & - is_q_point=.true., is_interface=.true.) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%dsamp(dl)%axesCui, dl, & - x_cell_method='point', y_cell_method='mean', v_cell_method='point', & - is_u_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%dsamp(dl)%axesCvi, dl, & - x_cell_method='mean', y_cell_method='point', v_cell_method='point', & - is_v_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - - ! Axis groupings for 2-D arrays - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh /), diag_cs%dsamp(dl)%axesT1, dl, & - x_cell_method='mean', y_cell_method='mean', is_h_point=.true.) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq /), diag_cs%dsamp(dl)%axesB1, dl, & - x_cell_method='point', y_cell_method='point', is_q_point=.true.) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh /), diag_cs%dsamp(dl)%axesCu1, dl, & - x_cell_method='point', y_cell_method='mean', is_u_point=.true.) - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq /), diag_cs%dsamp(dl)%axesCv1, dl, & - x_cell_method='mean', y_cell_method='point', is_v_point=.true.) - - !Non-native axes - if (diag_cs%num_diag_coords>0) then - allocate(diag_cs%dsamp(dl)%remap_axesTL(diag_cs%num_diag_coords)) - allocate(diag_cs%dsamp(dl)%remap_axesBL(diag_cs%num_diag_coords)) - allocate(diag_cs%dsamp(dl)%remap_axesCuL(diag_cs%num_diag_coords)) - allocate(diag_cs%dsamp(dl)%remap_axesCvL(diag_cs%num_diag_coords)) - allocate(diag_cs%dsamp(dl)%remap_axesTi(diag_cs%num_diag_coords)) - allocate(diag_cs%dsamp(dl)%remap_axesBi(diag_cs%num_diag_coords)) - allocate(diag_cs%dsamp(dl)%remap_axesCui(diag_cs%num_diag_coords)) - allocate(diag_cs%dsamp(dl)%remap_axesCvi(diag_cs%num_diag_coords)) - endif - - do i=1, diag_cs%num_diag_coords - ! For each possible diagnostic coordinate - !call diag_remap_configure_axes(diag_cs%diag_remap_cs(i), GV, param_file) - - ! This vertical coordinate has been configured so can be used. - if (diag_remap_axes_configured(diag_cs%diag_remap_cs(i))) then - - ! This fetches the 1D-axis id for layers and interfaces and overwrite - ! id_zl and id_zi from above. It also returns the number of layers. - call diag_remap_get_axes_info(diag_cs%diag_remap_cs(i), nz, id_zL, id_zi) - - ! Axes for z layers - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%remap_axesTL(i), dl, & + deallocate(gridLonT_dsamp,gridLatT_dsamp) + + ! Axis groupings for the model layers + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%axesTL, dl, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & + is_h_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%dsamp(dl)%axesBL, dl, & + x_cell_method='point', y_cell_method='point', v_cell_method='mean', & + is_q_point=.true., is_layer=.true.) + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%dsamp(dl)%axesCuL, dl, & + x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & + is_u_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%dsamp(dl)%axesCvL, dl, & + x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & + is_v_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + + ! Axis groupings for the model interfaces + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%dsamp(dl)%axesTi, dl, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & + is_h_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%dsamp(dl)%axesBi, dl, & + x_cell_method='point', y_cell_method='point', v_cell_method='point', & + is_q_point=.true., is_interface=.true.) + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%dsamp(dl)%axesCui, dl, & + x_cell_method='point', y_cell_method='mean', v_cell_method='point', & + is_u_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%dsamp(dl)%axesCvi, dl, & + x_cell_method='mean', y_cell_method='point', v_cell_method='point', & + is_v_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + + ! Axis groupings for 2-D arrays + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh /), diag_cs%dsamp(dl)%axesT1, dl, & + x_cell_method='mean', y_cell_method='mean', is_h_point=.true.) + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq /), diag_cs%dsamp(dl)%axesB1, dl, & + x_cell_method='point', y_cell_method='point', is_q_point=.true.) + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh /), diag_cs%dsamp(dl)%axesCu1, dl, & + x_cell_method='point', y_cell_method='mean', is_u_point=.true.) + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq /), diag_cs%dsamp(dl)%axesCv1, dl, & + x_cell_method='mean', y_cell_method='point', is_v_point=.true.) + + !Non-native axes + if (diag_cs%num_diag_coords>0) then + allocate(diag_cs%dsamp(dl)%remap_axesTL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesBL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCuL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCvL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesTi(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesBi(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCui(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCvi(diag_cs%num_diag_coords)) + endif + + do i=1, diag_cs%num_diag_coords + ! For each possible diagnostic coordinate + !call diag_remap_configure_axes(diag_cs%diag_remap_cs(i), GV, param_file) + + ! This vertical coordinate has been configured so can be used. + if (diag_remap_axes_configured(diag_cs%diag_remap_cs(i))) then + + ! This fetches the 1D-axis id for layers and interfaces and overwrite + ! id_zl and id_zi from above. It also returns the number of layers. + call diag_remap_get_axes_info(diag_cs%diag_remap_cs(i), nz, id_zL, id_zi) + + ! Axes for z layers + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%remap_axesTL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) - !! \note Remapping for B points is not yet implemented so needs_remapping is not - !! provided for remap_axesBL - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%dsamp(dl)%remap_axesBL(i), dl, & + !! \note Remapping for B points is not yet implemented so needs_remapping is not + !! provided for remap_axesBL + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%dsamp(dl)%remap_axesBL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='point', v_cell_method='mean', & is_q_point=.true., is_layer=.true., is_native=.false.) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%dsamp(dl)%remap_axesCuL(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%dsamp(dl)%remap_axesCuL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & is_u_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%dsamp(dl)%remap_axesCvL(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%dsamp(dl)%remap_axesCvL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & is_v_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) - ! Axes for z interfaces - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%dsamp(dl)%remap_axesTi(i), dl, & + ! Axes for z interfaces + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%dsamp(dl)%remap_axesTi(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & is_h_point=.true., is_interface=.true., is_native=.false., needs_interpolating=.true., & xyave_axes=diag_cs%remap_axesZi(i)) - !! \note Remapping for B points is not yet implemented so needs_remapping is not provided for remap_axesBi - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%dsamp(dl)%remap_axesBi(i), dl, & + !! \note Remapping for B points is not yet implemented so needs_remapping is not provided for remap_axesBi + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%dsamp(dl)%remap_axesBi(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='point', v_cell_method='point', & is_q_point=.true., is_interface=.true., is_native=.false.) - call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%dsamp(dl)%remap_axesCui(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%dsamp(dl)%remap_axesCui(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='mean', v_cell_method='point', & is_u_point=.true., is_interface=.true., is_native=.false., & needs_interpolating=.true., xyave_axes=diag_cs%remap_axesZi(i)) - call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%dsamp(dl)%remap_axesCvi(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%dsamp(dl)%remap_axesCvi(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='point', v_cell_method='point', & is_v_point=.true., is_interface=.true., is_native=.false., & needs_interpolating=.true., xyave_axes=diag_cs%remap_axesZi(i)) - endif - enddo + endif + enddo enddo end subroutine set_axes_info_dsamp @@ -871,49 +870,49 @@ subroutine set_masks_for_axes_dsamp(G, diag_cs) !The downsampled mask is needed for sending out the diagnostics output via diag_manager !The non-downsampled mask is needed for downsampling the diagnostics field do dl=2,MAX_DSAMP_LEV - if (dl /= 2) call MOM_error(FATAL, "set_masks_for_axes_dsamp: Downsample level other than 2 is not supported!") - do c=1, diag_cs%num_diag_coords - ! Level/layer h-points in diagnostic coordinate - axes => diag_cs%remap_axesTL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTL(c)%dsamp(dl)%mask3d, dl,G%isc, G%jsc, & - G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) - diag_cs%dsamp(dl)%remap_axesTL(c)%mask3d => axes%mask3d !set non-downsampled mask - ! Level/layer u-points in diagnostic coordinate - axes => diag_cs%remap_axesCuL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCuL(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & - G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) - diag_cs%dsamp(dl)%remap_axesCul(c)%mask3d => axes%mask3d !set non-downsampled mask - ! Level/layer v-points in diagnostic coordinate - axes => diag_cs%remap_axesCvL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvL(c)%dsamp(dl)%mask3d, dl,G%isc ,G%JscB, & - G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) - diag_cs%dsamp(dl)%remap_axesCvL(c)%mask3d => axes%mask3d !set non-downsampled mask - ! Level/layer q-points in diagnostic coordinate - axes => diag_cs%remap_axesBL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBL(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & - G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) - diag_cs%dsamp(dl)%remap_axesBL(c)%mask3d => axes%mask3d !set non-downsampled mask - ! Interface h-points in diagnostic coordinate (w-point) - axes => diag_cs%remap_axesTi(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTi(c)%dsamp(dl)%mask3d, dl,G%isc, G%jsc, & - G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) - diag_cs%dsamp(dl)%remap_axesTi(c)%mask3d => axes%mask3d !set non-downsampled mask - ! Interface u-points in diagnostic coordinate - axes => diag_cs%remap_axesCui(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCui(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & - G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) - diag_cs%dsamp(dl)%remap_axesCui(c)%mask3d => axes%mask3d !set non-downsampled mask - ! Interface v-points in diagnostic coordinate - axes => diag_cs%remap_axesCvi(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvi(c)%dsamp(dl)%mask3d, dl,G%isc ,G%JscB, & - G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) - diag_cs%dsamp(dl)%remap_axesCvi(c)%mask3d => axes%mask3d !set non-downsampled mask - ! Interface q-points in diagnostic coordinate - axes => diag_cs%remap_axesBi(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBi(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & - G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) - diag_cs%dsamp(dl)%remap_axesBi(c)%mask3d => axes%mask3d !set non-downsampled mask - enddo + if (dl /= 2) call MOM_error(FATAL, "set_masks_for_axes_dsamp: Downsample level other than 2 is not supported!") + do c=1, diag_cs%num_diag_coords + ! Level/layer h-points in diagnostic coordinate + axes => diag_cs%remap_axesTL(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTL(c)%dsamp(dl)%mask3d, dl,G%isc, G%jsc, & + G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) + diag_cs%dsamp(dl)%remap_axesTL(c)%mask3d => axes%mask3d !set non-downsampled mask + ! Level/layer u-points in diagnostic coordinate + axes => diag_cs%remap_axesCuL(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCuL(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) + diag_cs%dsamp(dl)%remap_axesCul(c)%mask3d => axes%mask3d !set non-downsampled mask + ! Level/layer v-points in diagnostic coordinate + axes => diag_cs%remap_axesCvL(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvL(c)%dsamp(dl)%mask3d, dl,G%isc ,G%JscB, & + G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) + diag_cs%dsamp(dl)%remap_axesCvL(c)%mask3d => axes%mask3d !set non-downsampled mask + ! Level/layer q-points in diagnostic coordinate + axes => diag_cs%remap_axesBL(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBL(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) + diag_cs%dsamp(dl)%remap_axesBL(c)%mask3d => axes%mask3d !set non-downsampled mask + ! Interface h-points in diagnostic coordinate (w-point) + axes => diag_cs%remap_axesTi(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTi(c)%dsamp(dl)%mask3d, dl,G%isc, G%jsc, & + G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) + diag_cs%dsamp(dl)%remap_axesTi(c)%mask3d => axes%mask3d !set non-downsampled mask + ! Interface u-points in diagnostic coordinate + axes => diag_cs%remap_axesCui(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCui(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) + diag_cs%dsamp(dl)%remap_axesCui(c)%mask3d => axes%mask3d !set non-downsampled mask + ! Interface v-points in diagnostic coordinate + axes => diag_cs%remap_axesCvi(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvi(c)%dsamp(dl)%mask3d, dl,G%isc ,G%JscB, & + G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) + diag_cs%dsamp(dl)%remap_axesCvi(c)%mask3d => axes%mask3d !set non-downsampled mask + ! Interface q-points in diagnostic coordinate + axes => diag_cs%remap_axesBi(c) + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBi(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) + diag_cs%dsamp(dl)%remap_axesBi(c)%mask3d => axes%mask3d !set non-downsampled mask + enddo enddo end subroutine set_masks_for_axes_dsamp @@ -1937,10 +1936,10 @@ end function get_diag_time_end !> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics !! derived from one field. integer function register_diag_field(module_name, field_name, axes_in, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & - cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & - x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & + cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & + x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive) character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -2221,10 +2220,10 @@ end function register_diag_field !> Returns True if either the native or CMOr version of the diagnostic were registered. Updates 'dm_id' !! after calling register_diag_field_expand_axes() for both native and CMOR variants of the field. logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, axes, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & - cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & - x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & + cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & + x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive) integer, intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -2364,8 +2363,8 @@ end function register_diag_field_expand_cmor !> Returns an FMS id from register_diag_field_fms (the diag_manager routine) after expanding axes !! (axes-group) into handles and conditionally adding an FMS area_id for cell_measures. integer function register_diag_field_expand_axes(module_name, field_name, axes, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count) character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -2519,36 +2518,36 @@ subroutine add_xyz_method(diag, axes, x_cell_method, y_cell_method, v_cell_metho mstr = diag%axes%v_cell_method if (present(v_extensive)) then - if (present(v_cell_method)) call MOM_error(FATAL, "attach_cell_methods: " // & - 'Vertical cell method was specified along with the vertically extensive flag.') - if (v_extensive) then - mstr='sum' - else - mstr='mean' - endif + if (present(v_cell_method)) call MOM_error(FATAL, "attach_cell_methods: " // & + 'Vertical cell method was specified along with the vertically extensive flag.') + if (v_extensive) then + mstr='sum' + else + mstr='mean' + endif elseif (present(v_cell_method)) then - mstr = v_cell_method + mstr = v_cell_method endif if (trim(mstr)=='sum') then - xyz_method = xyz_method + 1 + xyz_method = xyz_method + 1 elseif (trim(mstr)=='mean') then - xyz_method = xyz_method + 2 + xyz_method = xyz_method + 2 endif mstr = diag%axes%y_cell_method if (present(y_cell_method)) mstr = y_cell_method if (trim(mstr)=='sum') then - xyz_method = xyz_method + 10 + xyz_method = xyz_method + 10 elseif (trim(mstr)=='mean') then - xyz_method = xyz_method + 20 + xyz_method = xyz_method + 20 endif mstr = diag%axes%x_cell_method if (present(x_cell_method)) mstr = x_cell_method if (trim(mstr)=='sum') then - xyz_method = xyz_method + 100 + xyz_method = xyz_method + 100 elseif (trim(mstr)=='mean') then - xyz_method = xyz_method + 200 + xyz_method = xyz_method + 200 endif diag%xyz_method = xyz_method @@ -2641,15 +2640,15 @@ subroutine attach_cell_methods(id, axes, ostring, cell_methods, & ostring = trim(adjustl(ostring))//' '//trim(axis_name)//':'//trim(v_cell_method) endif elseif (present(v_extensive)) then - if (v_extensive) then - if (axes%rank==1) then - call get_diag_axis_name(axes%handles(1), axis_name) - elseif (axes%rank==3) then - call get_diag_axis_name(axes%handles(3), axis_name) + if (v_extensive) then + if (axes%rank==1) then + call get_diag_axis_name(axes%handles(1), axis_name) + elseif (axes%rank==3) then + call get_diag_axis_name(axes%handles(3), axis_name) + endif + call diag_field_add_attribute(id, 'cell_methods', trim(axis_name)//':sum') + ostring = trim(adjustl(ostring))//' '//trim(axis_name)//':sum' endif - call diag_field_add_attribute(id, 'cell_methods', trim(axis_name)//':sum') - ostring = trim(adjustl(ostring))//' '//trim(axis_name)//':sum' - endif else if (len(trim(axes%v_cell_method))>0) then if (axes%rank==1) then @@ -2673,9 +2672,9 @@ subroutine attach_cell_methods(id, axes, ostring, cell_methods, & end subroutine attach_cell_methods function register_scalar_field(module_name, field_name, init_time, diag_cs, & - long_name, units, missing_value, range, standard_name, & - do_not_log, err_msg, interp_method, cmor_field_name, & - cmor_long_name, cmor_units, cmor_standard_name) + long_name, units, missing_value, range, standard_name, & + do_not_log, err_msg, interp_method, cmor_field_name, & + cmor_long_name, cmor_units, cmor_standard_name) integer :: register_scalar_field !< An integer handle for a diagnostic array. character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" @@ -2777,10 +2776,10 @@ end function register_scalar_field !> Registers a static diagnostic, returning an integer handle function register_static_field(module_name, field_name, axes, & - long_name, units, missing_value, range, mask_variant, standard_name, & - do_not_log, interp_method, tile_count, & - cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, area, & - x_cell_method, y_cell_method, area_cell_method, conversion) + long_name, units, missing_value, range, mask_variant, standard_name, & + do_not_log, interp_method, tile_count, & + cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, area, & + x_cell_method, y_cell_method, area_cell_method, conversion) integer :: register_static_field !< An integer handle for a diagnostic array. character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" @@ -3301,8 +3300,8 @@ subroutine diag_update_remap_grids(diag_cs, alt_h, alt_T, alt_S, update_intensiv if (id_clock_diag_grid_updates>0) call cpu_clock_begin(id_clock_diag_grid_updates) if (diag_cs%diag_grid_overridden) then - call MOM_error(FATAL, "diag_update_remap_grids was called, but current grids in "// & - "diagnostic structure have been overridden") + call MOM_error(FATAL, "diag_update_remap_grids was called, but current grids in "// & + "diagnostic structure have been overridden") endif if (update_intensive_local) then @@ -3418,18 +3417,18 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) deallocate(diag_cs%mask3dCui) deallocate(diag_cs%mask3dCvi) do i=2,MAX_DSAMP_LEV - deallocate(diag_cs%dsamp(i)%mask2dT) - deallocate(diag_cs%dsamp(i)%mask2dBu) - deallocate(diag_cs%dsamp(i)%mask2dCu) - deallocate(diag_cs%dsamp(i)%mask2dCv) - deallocate(diag_cs%dsamp(i)%mask3dTL) - deallocate(diag_cs%dsamp(i)%mask3dBL) - deallocate(diag_cs%dsamp(i)%mask3dCuL) - deallocate(diag_cs%dsamp(i)%mask3dCvL) - deallocate(diag_cs%dsamp(i)%mask3dTi) - deallocate(diag_cs%dsamp(i)%mask3dBi) - deallocate(diag_cs%dsamp(i)%mask3dCui) - deallocate(diag_cs%dsamp(i)%mask3dCvi) + deallocate(diag_cs%dsamp(i)%mask2dT) + deallocate(diag_cs%dsamp(i)%mask2dBu) + deallocate(diag_cs%dsamp(i)%mask2dCu) + deallocate(diag_cs%dsamp(i)%mask2dCv) + deallocate(diag_cs%dsamp(i)%mask3dTL) + deallocate(diag_cs%dsamp(i)%mask3dBL) + deallocate(diag_cs%dsamp(i)%mask3dCuL) + deallocate(diag_cs%dsamp(i)%mask3dCvL) + deallocate(diag_cs%dsamp(i)%mask3dTi) + deallocate(diag_cs%dsamp(i)%mask3dBi) + deallocate(diag_cs%dsamp(i)%mask3dCui) + deallocate(diag_cs%dsamp(i)%mask3dCvi) enddo #if defined(DEBUG) || defined(__DO_SAFETY_CHECKS__) @@ -3579,9 +3578,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 @@ -3592,7 +3592,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 @@ -3717,37 +3717,37 @@ subroutine downsample_diag_masks_set(G, nz, diag_cs) ! coarse d extents 1 28 1 28 do dl=2,MAX_DSAMP_LEV - ! 2d mask - call downsample_mask(G%mask2dT, diag_cs%dsamp(dl)%mask2dT, dl,G%isc, G%jsc, & - G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) - call downsample_mask(G%mask2dBu,diag_cs%dsamp(dl)%mask2dBu, dl,G%IscB,G%JscB, & - G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) - call downsample_mask(G%mask2dCu,diag_cs%dsamp(dl)%mask2dCu, dl,G%IscB,G%JscB, & - G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) - call downsample_mask(G%mask2dCv,diag_cs%dsamp(dl)%mask2dCv, dl,G%isc ,G%JscB, & - G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) - ! 3d native masks are needed by diag_manager but the native variables - ! can only be masked 2d - for ocean points, all layers exists. - allocate(diag_cs%dsamp(dl)%mask3dTL(G%HId2%isd:G%HId2%ied,G%HId2%jsd:G%HId2%jed,1:nz)) - allocate(diag_cs%dsamp(dl)%mask3dBL(G%HId2%IsdB:G%HId2%IedB,G%HId2%JsdB:G%HId2%JedB,1:nz)) - allocate(diag_cs%dsamp(dl)%mask3dCuL(G%HId2%IsdB:G%HId2%IedB,G%HId2%jsd:G%HId2%jed,1:nz)) - allocate(diag_cs%dsamp(dl)%mask3dCvL(G%HId2%isd:G%HId2%ied,G%HId2%JsdB:G%HId2%JedB,1:nz)) - do k=1,nz - diag_cs%dsamp(dl)%mask3dTL(:,:,k) = diag_cs%dsamp(dl)%mask2dT(:,:) - diag_cs%dsamp(dl)%mask3dBL(:,:,k) = diag_cs%dsamp(dl)%mask2dBu(:,:) - diag_cs%dsamp(dl)%mask3dCuL(:,:,k) = diag_cs%dsamp(dl)%mask2dCu(:,:) - diag_cs%dsamp(dl)%mask3dCvL(:,:,k) = diag_cs%dsamp(dl)%mask2dCv(:,:) - enddo - allocate(diag_cs%dsamp(dl)%mask3dTi(G%HId2%isd:G%HId2%ied,G%HId2%jsd:G%HId2%jed,1:nz+1)) - allocate(diag_cs%dsamp(dl)%mask3dBi(G%HId2%IsdB:G%HId2%IedB,G%HId2%JsdB:G%HId2%JedB,1:nz+1)) - allocate(diag_cs%dsamp(dl)%mask3dCui(G%HId2%IsdB:G%HId2%IedB,G%HId2%jsd:G%HId2%jed,1:nz+1)) - allocate(diag_cs%dsamp(dl)%mask3dCvi(G%HId2%isd:G%HId2%ied,G%HId2%JsdB:G%HId2%JedB,1:nz+1)) - do k=1,nz+1 - diag_cs%dsamp(dl)%mask3dTi(:,:,k) = diag_cs%dsamp(dl)%mask2dT(:,:) - diag_cs%dsamp(dl)%mask3dBi(:,:,k) = diag_cs%dsamp(dl)%mask2dBu(:,:) - diag_cs%dsamp(dl)%mask3dCui(:,:,k) = diag_cs%dsamp(dl)%mask2dCu(:,:) - diag_cs%dsamp(dl)%mask3dCvi(:,:,k) = diag_cs%dsamp(dl)%mask2dCv(:,:) - enddo + ! 2d mask + call downsample_mask(G%mask2dT, diag_cs%dsamp(dl)%mask2dT, dl,G%isc, G%jsc, & + G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) + call downsample_mask(G%mask2dBu,diag_cs%dsamp(dl)%mask2dBu, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) + call downsample_mask(G%mask2dCu,diag_cs%dsamp(dl)%mask2dCu, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) + call downsample_mask(G%mask2dCv,diag_cs%dsamp(dl)%mask2dCv, dl,G%isc ,G%JscB, & + G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) + ! 3d native masks are needed by diag_manager but the native variables + ! can only be masked 2d - for ocean points, all layers exists. + allocate(diag_cs%dsamp(dl)%mask3dTL(G%HId2%isd:G%HId2%ied,G%HId2%jsd:G%HId2%jed,1:nz)) + allocate(diag_cs%dsamp(dl)%mask3dBL(G%HId2%IsdB:G%HId2%IedB,G%HId2%JsdB:G%HId2%JedB,1:nz)) + allocate(diag_cs%dsamp(dl)%mask3dCuL(G%HId2%IsdB:G%HId2%IedB,G%HId2%jsd:G%HId2%jed,1:nz)) + allocate(diag_cs%dsamp(dl)%mask3dCvL(G%HId2%isd:G%HId2%ied,G%HId2%JsdB:G%HId2%JedB,1:nz)) + do k=1,nz + diag_cs%dsamp(dl)%mask3dTL(:,:,k) = diag_cs%dsamp(dl)%mask2dT(:,:) + diag_cs%dsamp(dl)%mask3dBL(:,:,k) = diag_cs%dsamp(dl)%mask2dBu(:,:) + diag_cs%dsamp(dl)%mask3dCuL(:,:,k) = diag_cs%dsamp(dl)%mask2dCu(:,:) + diag_cs%dsamp(dl)%mask3dCvL(:,:,k) = diag_cs%dsamp(dl)%mask2dCv(:,:) + enddo + allocate(diag_cs%dsamp(dl)%mask3dTi(G%HId2%isd:G%HId2%ied,G%HId2%jsd:G%HId2%jed,1:nz+1)) + allocate(diag_cs%dsamp(dl)%mask3dBi(G%HId2%IsdB:G%HId2%IedB,G%HId2%JsdB:G%HId2%JedB,1:nz+1)) + allocate(diag_cs%dsamp(dl)%mask3dCui(G%HId2%IsdB:G%HId2%IedB,G%HId2%jsd:G%HId2%jed,1:nz+1)) + allocate(diag_cs%dsamp(dl)%mask3dCvi(G%HId2%isd:G%HId2%ied,G%HId2%JsdB:G%HId2%JedB,1:nz+1)) + do k=1,nz+1 + diag_cs%dsamp(dl)%mask3dTi(:,:,k) = diag_cs%dsamp(dl)%mask2dT(:,:) + diag_cs%dsamp(dl)%mask3dBi(:,:,k) = diag_cs%dsamp(dl)%mask2dBu(:,:) + diag_cs%dsamp(dl)%mask3dCui(:,:,k) = diag_cs%dsamp(dl)%mask2dCu(:,:) + diag_cs%dsamp(dl)%mask3dCvi(:,:,k) = diag_cs%dsamp(dl)%mask2dCv(:,:) + enddo enddo end subroutine downsample_diag_masks_set @@ -3774,13 +3774,13 @@ subroutine downsample_diag_indices_get(fo1, fo2, dl, diag_cs, isv, iev, jsv, jev !We want this check to error out only if there was a downsampled diagnostics requested and about to post that is !why the check is here and not in the init routines. This check need to be done only once, hence the outer if. if (first_check) then - if (mod(diag_cs%ie-diag_cs%is+1, dl) /= 0 .OR. mod(diag_cs%je-diag_cs%js+1, dl) /= 0) then - write (mesg,*) "Non-commensurate downsampled domain is not supported. "//& + if (mod(diag_cs%ie-diag_cs%is+1, dl) /= 0 .OR. mod(diag_cs%je-diag_cs%js+1, dl) /= 0) then + write (mesg,*) "Non-commensurate downsampled domain is not supported. "//& "Please choose a layout such that NIGLOBAL/Layout_X and NJGLOBAL/Layout_Y are both divisible by dl=",dl,& " Current domain extents: ", diag_cs%is,diag_cs%ie, diag_cs%js,diag_cs%je - call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) - endif - first_check = .false. + call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) + endif + first_check = .false. endif cszi = diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc +1 ; dszi = diag_cs%dsamp(dl)%ied-diag_cs%dsamp(dl)%isd +1 @@ -3791,35 +3791,35 @@ subroutine downsample_diag_indices_get(fo1, fo2, dl, diag_cs, isv, iev, jsv, jev f2 = fo2/dl !Correction for the symmetric case if (diag_cs%G%symmetric) then - f1 = f1 + mod(fo1,dl) - f2 = f2 + mod(fo2,dl) + f1 = f1 + mod(fo1,dl) + f2 = f2 + mod(fo2,dl) endif if ( f1 == dszi ) then - isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec ! field on Data domain, take compute domain indcies + isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec ! field on Data domain, take compute domain indcies !The rest is not taken with the full MOM6 diag_table elseif ( f1 == dszi + 1 ) then - isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec+1 ! Symmetric data domain + isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec+1 ! Symmetric data domain elseif ( f1 == cszi) then - isv = 1 ; iev = (diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc) +1 ! Computational domain + isv = 1 ; iev = (diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc) +1 ! Computational domain elseif ( f1 == cszi + 1 ) then - isv = 1 ; iev = (diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc) +2 ! Symmetric computational domain + isv = 1 ; iev = (diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc) +2 ! Symmetric computational domain else - write (mesg,*) " peculiar size ",f1," in i-direction\n"//& + write (mesg,*) " peculiar size ",f1," in i-direction\n"//& "does not match one of ", cszi, cszi+1, dszi, dszi+1 - call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) + call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) endif if ( f2 == dszj ) then - jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec ! Data domain + jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec ! Data domain elseif ( f2 == dszj + 1 ) then - jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec+1 ! Symmetric data domain + jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec+1 ! Symmetric data domain elseif ( f2 == cszj) then - jsv = 1 ; jev = (diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc) +1 ! Computational domain + jsv = 1 ; jev = (diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc) +1 ! Computational domain elseif ( f2 == cszj + 1 ) then - jsv = 1 ; jev = (diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc) +2 ! Symmetric computational domain + jsv = 1 ; jev = (diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc) +2 ! Symmetric computational domain else - write (mesg,*) " peculiar size ",f2," in j-direction\n"//& + write (mesg,*) " peculiar size ",f2," in j-direction\n"//& "does not match one of ", cszj, cszj+1, dszj, dszj+1 - call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) + call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) endif end subroutine downsample_diag_indices_get @@ -3844,23 +3844,23 @@ subroutine downsample_diag_field_3d(locfield, locfield_dsamp, dl, diag_cs, diag, locmask => NULL() !Get the correct indices corresponding to input field !Shape of the input diag field - f1 = size(locfield,1) - f2 = size(locfield,2) + f1 = size(locfield, 1) + f2 = size(locfield, 2) !Save the extents of the original (fine) domain isv_o = isv ; jsv_o = jsv !Get the shape of the downsampled field and overwrite isv,iev,jsv,jev with them - call downsample_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) + call downsample_diag_indices_get(f1, f2, dl, diag_cs, isv, iev, jsv, jev) !Set the non-downsampled mask, it must be associated and initialized if (present(mask)) then - locmask => mask + locmask => mask elseif (associated(diag%axes%mask3d)) then - locmask => diag%axes%mask3d + locmask => diag%axes%mask3d else - call MOM_error(FATAL, "downsample_diag_field_3d: Cannot downsample without a mask!!! ") + call MOM_error(FATAL, "downsample_diag_field_3d: Cannot downsample without a mask!!! ") endif call downsample_field(locfield, locfield_dsamp, dl, diag%xyz_method, locmask, diag_cs, diag, & - isv_o,jsv_o,isv,iev,jsv,jev) + isv_o, jsv_o, isv, iev, jsv, jev) end subroutine downsample_diag_field_3d @@ -3979,117 +3979,117 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d f2 = f_in2/dl !Correction for the symmetric case if (diag_cs%G%symmetric) then - f1 = f1 + mod(f_in1,dl) - f2 = f2 + mod(f_in2,dl) + f1 = f1 + mod(f_in1,dl) + f2 = f2 + mod(f_in2,dl) endif allocate(field_out(1:f1,1:f2,ks:ke)) ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain if (method == MMM) then - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!! - weight = mask(ii,jj,k) * diag_cs%G%areaT(ii,jj) * diag_cs%h(ii,jj,k) - total_weight = total_weight + weight - ave = ave+field_in(ii,jj,k) * weight - enddo ; enddo - field_out(i,j,k) = ave/(total_weight + eps_vol) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo ; enddo - elseif (method == SSS) then !e.g., volcello - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - weight = mask(ii,jj,k) - ave = ave+field_in(ii,jj,k)*weight - enddo ; enddo - field_out(i,j,k) = ave !Masked Sum (total_weight=1) - enddo ; enddo ; enddo - elseif (method == MMP .or. method == MMS) then !e.g., T_advection_xy - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj,k) * diag_cs%G%areaT(ii,jj) - total_weight = total_weight + weight - ave = ave+field_in(ii,jj,k)*weight - enddo ; enddo - field_out(i,j,k) = ave / (total_weight+eps_area) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo ; enddo + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!! + weight = mask(ii,jj,k) * diag_cs%G%areaT(ii,jj) * diag_cs%h(ii,jj,k) + total_weight = total_weight + weight + ave = ave+field_in(ii,jj,k) * weight + enddo ; enddo + field_out(i,j,k) = ave/(total_weight + eps_vol) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo ; enddo + elseif (method == SSS) then !e.g., volcello + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + weight = mask(ii,jj,k) + ave = ave+field_in(ii,jj,k)*weight + enddo ; enddo + field_out(i,j,k) = ave !Masked Sum (total_weight=1) + enddo ; enddo ; enddo + elseif (method == MMP .or. method == MMS) then !e.g., T_advection_xy + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj,k) * diag_cs%G%areaT(ii,jj) + total_weight = total_weight + weight + ave = ave+field_in(ii,jj,k)*weight + enddo ; enddo + field_out(i,j,k) = ave / (total_weight+eps_area) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo ; enddo elseif (method == PMM) then - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - ii=i0 - do jj=j0,j0+dl-1 - weight = mask(ii,jj,k) * diag_cs%G%dyCu(ii,jj) * diag_cs%h(ii,jj,k) - total_weight = total_weight +weight - ave = ave+field_in(ii,jj,k)*weight - enddo - field_out(i,j,k) = ave/(total_weight+eps_face) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo ; enddo + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight = mask(ii,jj,k) * diag_cs%G%dyCu(ii,jj) * diag_cs%h(ii,jj,k) + total_weight = total_weight +weight + ave = ave+field_in(ii,jj,k)*weight + enddo + field_out(i,j,k) = ave/(total_weight+eps_face) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo ; enddo elseif (method == PSS) then !e.g. umo - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - ii=i0 - do jj=j0,j0+dl-1 - weight = mask(ii,jj,k) - ave = ave+field_in(ii,jj,k)*weight - enddo - field_out(i,j,k) = ave !Masked Sum (total_weight=1) - enddo ; enddo ; enddo - elseif (method == SPS) then !e.g. vmo - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - jj=j0 - do ii=i0,i0+dl-1 - weight = mask(ii,jj,k) - ave = ave+field_in(ii,jj,k)*weight - enddo - field_out(i,j,k) = ave !Masked Sum (total_weight=1) - enddo ; enddo ; enddo + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight = mask(ii,jj,k) + ave = ave+field_in(ii,jj,k)*weight + enddo + field_out(i,j,k) = ave !Masked Sum (total_weight=1) + enddo ; enddo ; enddo + elseif (method == SPS) then !e.g. vmo + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + weight = mask(ii,jj,k) + ave = ave+field_in(ii,jj,k)*weight + enddo + field_out(i,j,k) = ave !Masked Sum (total_weight=1) + enddo ; enddo ; enddo elseif (method == MPM) then - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - jj=j0 - do ii=i0,i0+dl-1 - weight = mask(ii,jj,k) * diag_cs%G%dxCv(ii,jj) * diag_cs%h(ii,jj,k) - total_weight = total_weight + weight - ave = ave+field_in(ii,jj,k)*weight - enddo - field_out(i,j,k) = ave/(total_weight+eps_face) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo ; enddo + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + weight = mask(ii,jj,k) * diag_cs%G%dxCv(ii,jj) * diag_cs%h(ii,jj,k) + total_weight = total_weight + weight + ave = ave+field_in(ii,jj,k)*weight + enddo + field_out(i,j,k) = ave/(total_weight+eps_face) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo ; enddo elseif (method == MSK) then !The input field is a mask, subsample - field_out(:,:,:) = 0.0 - do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - ave = ave+field_in(ii,jj,k) - enddo ; enddo - if (ave > 0.0) field_out(i,j,k)=1.0 - enddo ; enddo ; enddo + field_out(:,:,:) = 0.0 + do k=ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + ave = ave+field_in(ii,jj,k) + enddo ; enddo + if (ave > 0.0) field_out(i,j,k)=1.0 + enddo ; enddo ; enddo else - write (mesg,*) " unknown sampling method: ",method - call MOM_error(FATAL, "downsample_field_3d: "//trim(mesg)//" "//trim(diag%debug_str)) + write (mesg,*) " unknown sampling method: ",method + call MOM_error(FATAL, "downsample_field_3d: "//trim(mesg)//" "//trim(diag%debug_str)) endif end subroutine downsample_field_3d @@ -4133,109 +4133,109 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d f2 = f_in2/dl ! Correction for the symmetric case if (diag_cs%G%symmetric) then - f1 = f1 + mod(f_in1,dl) - f2 = f2 + mod(f_in2,dl) + f1 = f1 + mod(f_in1,dl) + f2 = f2 + mod(f_in2,dl) endif allocate(field_out(1:f1,1:f2)) if (method == MMP) then - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) - total_weight = total_weight + weight - ave = ave+field_in(ii,jj)*weight - enddo ; enddo - field_out(i,j) = ave/(total_weight + eps_area) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) + total_weight = total_weight + weight + ave = ave+field_in(ii,jj)*weight + enddo ; enddo + field_out(i,j) = ave/(total_weight + eps_area) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo elseif (method == SSP) then ! e.g., T_dfxy_cont_tendency_2d - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj) - total_weight = total_weight + weight - ave = ave+field_in(ii,jj)*weight - enddo ; enddo - field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo - elseif (method == PSP) then ! e.g., umo_2d - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - ii=i0 - do jj=j0,j0+dl-1 - weight = mask(ii,jj) - total_weight = total_weight +weight - ave = ave+field_in(ii,jj)*weight - enddo - field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo - elseif (method == SPP) then ! e.g., vmo_2d - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - jj=j0 - do ii=i0,i0+dl-1 - weight = mask(ii,jj) - total_weight = total_weight +weight - ave = ave+field_in(ii,jj)*weight - enddo - field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj) + total_weight = total_weight + weight + ave = ave+field_in(ii,jj)*weight + enddo ; enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo + elseif (method == PSP) then ! e.g., umo_2d + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight = mask(ii,jj) + total_weight = total_weight +weight + ave = ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo + elseif (method == SPP) then ! e.g., vmo_2d + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + weight = mask(ii,jj) + total_weight = total_weight +weight + ave = ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo elseif (method == PMP) then - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - ii=i0 - do jj=j0,j0+dl-1 - weight = mask(ii,jj) * diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? - total_weight = total_weight +weight - ave = ave+field_in(ii,jj)*weight - enddo - field_out(i,j) = ave/(total_weight+eps_len) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight = mask(ii,jj) * diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + total_weight = total_weight +weight + ave = ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+eps_len) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo elseif (method == MPP) then - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - jj=j0 - do ii=i0,i0+dl-1 - weight = mask(ii,jj)* diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? - total_weight = total_weight +weight - ave = ave+field_in(ii,jj)*weight - enddo - field_out(i,j) = ave/(total_weight+eps_len) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo ; enddo + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + total_weight = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + weight = mask(ii,jj)* diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + total_weight = total_weight +weight + ave = ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+eps_len) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo ; enddo elseif (method == MSK) then !The input field is a mask, subsample - field_out(:,:) = 0.0 - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - ave = ave+field_in(ii,jj) - enddo ; enddo - if (ave > 0.0) field_out(i,j)=1.0 - enddo ; enddo + field_out(:,:) = 0.0 + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + ave = ave+field_in(ii,jj) + enddo ; enddo + if (ave > 0.0) field_out(i,j)=1.0 + enddo ; enddo else - write (mesg,*) " unknown sampling method: ",method - call MOM_error(FATAL, "downsample_field_2d: "//trim(mesg)//" "//trim(diag%debug_str)) + write (mesg,*) " unknown sampling method: ",method + call MOM_error(FATAL, "downsample_field_2d: "//trim(mesg)//" "//trim(diag%debug_str)) endif end subroutine downsample_field_2d @@ -4265,13 +4265,13 @@ subroutine downsample_mask_2d(field_in, field_out, dl, isc_o, jsc_o, isc_d, iec_ allocate(field_out(isd_d:ied_d,jsd_d:jed_d)) field_out(:,:) = 0.0 do j=jsc_d,jec_d ; do i=isc_d,iec_d - i0 = isc_o+dl*(i-isc_d) - j0 = jsc_o+dl*(j-jsc_d) - tot_non_zero = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - tot_non_zero = tot_non_zero + field_in(ii,jj) - enddo;enddo - if (tot_non_zero > 0.0) field_out(i,j)=1.0 + i0 = isc_o+dl*(i-isc_d) + j0 = jsc_o+dl*(j-jsc_d) + tot_non_zero = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + tot_non_zero = tot_non_zero + field_in(ii,jj) + enddo ; enddo + if (tot_non_zero > 0.0) field_out(i,j)=1.0 enddo ; enddo end subroutine downsample_mask_2d @@ -4301,13 +4301,13 @@ subroutine downsample_mask_3d(field_in, field_out, dl, isc_o, jsc_o, isc_d, iec_ allocate(field_out(isd_d:ied_d,jsd_d:jed_d,ks:ke)) field_out(:,:,:) = 0.0 do k=ks,ke ; do j=jsc_d,jec_d ; do i=isc_d,iec_d - i0 = isc_o+dl*(i-isc_d) - j0 = jsc_o+dl*(j-jsc_d) - tot_non_zero = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - tot_non_zero = tot_non_zero + field_in(ii,jj,k) - enddo;enddo - if (tot_non_zero > 0.0) field_out(i,j,k)=1.0 + i0 = isc_o+dl*(i-isc_d) + j0 = jsc_o+dl*(j-jsc_d) + tot_non_zero = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + tot_non_zero = tot_non_zero + field_in(ii,jj,k) + enddo ; enddo + if (tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo ; enddo ; enddo end subroutine downsample_mask_3d diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 6d1fa7b6fa..f27a153a2b 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -326,7 +326,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 @@ -384,7 +384,7 @@ subroutine diag_remap_do_remap(remap_cs, G, GV, h, staggered_in_x, staggered_in_ remapped_field(:,:,:) = 0. ! Symmetric grid offset under 1-based indexing; see header for details. - shift = 0; if (G%symmetric) shift = 1 + shift = 0 ; if (G%symmetric) shift = 1 if (staggered_in_x .and. .not. staggered_in_y) then ! U-points @@ -515,7 +515,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, h_target, staggered reintegrated_field(:,:,:) = 0. ! Symmetric grid offset under 1-based indexing; see header for details. - shift = 0; if (G%symmetric) shift = 1 + shift = 0 ; if (G%symmetric) shift = 1 if (staggered_in_x .and. .not. staggered_in_y) then ! U-points @@ -596,7 +596,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta nz_dest = remap_cs%nz ! Symmetric grid offset under 1-based indexing; see header for details. - shift = 0; if (G%symmetric) shift = 1 + shift = 0 ; if (G%symmetric) shift = 1 if (staggered_in_x .and. .not. staggered_in_y) then ! U-points diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 5a9212b600..3e7a2f9e84 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -837,8 +837,8 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f elseif (INDEX(value_string(1),',') > 0) then ! Initialize vals with an invalid date. vals(:) = (/ -999, -999, -999, 0, 0, 0, 0 /) - read(value_string(1),*,end=995,err=1005) vals - 995 continue + read(value_string(1), *, end=995, err=1005) vals + 995 continue if ((vals(1) < 0) .or. (vals(2) < 0) .or. (vals(3) < 0)) & call MOM_error(FATAL,'read_param_time: integer list read error for time-type variable '//& trim(varname)// ' parsing "'//trim(value_string(1))//'"') @@ -865,8 +865,9 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f endif ; endif endif return - 1005 call MOM_error(FATAL,'read_param_time: read error for time-type variable '//& - trim(varname)// ' parsing "'//trim(value_string(1))//'"') + + 1005 call MOM_error(FATAL, 'read_param_time: read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_time !> This function removes single and double quotes from a character string diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 8af6129812..4f98038f12 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -404,15 +404,15 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, allocate(lon_in(id),lat_in(jd),z_in(kd),z_edges_in(kd+1)) allocate(tr_z(isd:ied,jsd:jed,kd), mask_z(isd:ied,jsd:jed,kd)) - start = 1; count = 1; count(1) = id + start = 1 ; count = 1 ; count(1) = id rcode = NF90_GET_VAR(ncid, dim_id(1), lon_in, start, count) if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & trim(varnam)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1; count = 1; count(1) = jd + start = 1 ; count = 1 ; count(1) = jd rcode = NF90_GET_VAR(ncid, dim_id(2), lat_in, start, count) if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & trim(varnam)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1; count = 1; count(1) = kd + start = 1 ; count = 1 ; count(1) = kd rcode = NF90_GET_VAR(ncid, dim_id(3), z_in, start, count) if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & trim(varnam//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") @@ -422,48 +422,46 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (present(m_to_Z)) then ; do k=1,kd ; z_in(k) = m_to_Z * z_in(k) ; enddo ; endif ! extrapolate the input data to the north pole using the northerm-most latitude - add_np=.false. - jdp=jd + add_np = .false. + jdp = jd if (.not. is_ongrid) then - max_lat = maxval(lat_in) - if (max_lat < 90.0) then - add_np=.true. - jdp=jd+1 - allocate(lat_inp(jdp)) - lat_inp(1:jd)=lat_in(:) - lat_inp(jd+1)=90.0 - deallocate(lat_in) - allocate(lat_in(1:jdp)) - lat_in(:)=lat_inp(:) - endif + max_lat = maxval(lat_in) + if (max_lat < 90.0) then + add_np = .true. + jdp = jd+1 + allocate(lat_inp(jdp)) + lat_inp(1:jd) = lat_in(:) + lat_inp(jd+1) = 90.0 + deallocate(lat_in) + allocate(lat_in(1:jdp)) + lat_in(:) = lat_inp(:) + endif endif ! construct level cell boundaries as the mid-point between adjacent centers z_edges_in(1) = 0.0 do K=2,kd - z_edges_in(K)=0.5*(z_in(k-1)+z_in(k)) + z_edges_in(K) = 0.5*(z_in(k-1)+z_in(k)) enddo - z_edges_in(kd+1)=2.0*z_in(kd) - z_in(kd-1) + z_edges_in(kd+1) = 2.0*z_in(kd) - z_in(kd-1) if (is_ongrid) then - allocate(tr_in(is:ie,js:je)) ; tr_in(:,:)=0.0 - allocate(mask_in(is:ie,js:je)) ; mask_in(:,:)=0.0 + allocate(tr_in(is:ie,js:je)) ; tr_in(:,:)=0.0 + allocate(mask_in(is:ie,js:je)) ; mask_in(:,:)=0.0 else - call horiz_interp_init() - lon_in = lon_in*PI_180 - lat_in = lat_in*PI_180 - allocate(x_in(id,jdp),y_in(id,jdp)) - call meshgrid(lon_in,lat_in, x_in, y_in) - lon_out(:,:) = G%geoLonT(:,:)*PI_180 - lat_out(:,:) = G%geoLatT(:,:)*PI_180 - allocate(tr_in(id,jd)) ; tr_in(:,:)=0.0 - allocate(tr_inp(id,jdp)) ; tr_inp(:,:)=0.0 - allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 - allocate(last_row(id)) ; last_row(:)=0.0 + call horiz_interp_init() + lon_in = lon_in*PI_180 + lat_in = lat_in*PI_180 + allocate(x_in(id,jdp), y_in(id,jdp)) + call meshgrid(lon_in, lat_in, x_in, y_in) + lon_out(:,:) = G%geoLonT(:,:)*PI_180 + lat_out(:,:) = G%geoLatT(:,:)*PI_180 + allocate(tr_in(id,jd)) ; tr_in(:,:) = 0.0 + allocate(tr_inp(id,jdp)) ; tr_inp(:,:) = 0.0 + allocate(mask_in(id,jdp)) ; mask_in(:,:) = 0.0 + allocate(last_row(id)) ; last_row(:) = 0.0 endif - - max_depth = maxval(G%bathyT) call mpp_max(max_depth) @@ -475,7 +473,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, ! to define the layers do k=1,kd write(laynum,'(I8)') k ; laynum = adjustl(laynum) - mask_in=0.0 + mask_in = 0.0 if (is_ongrid) then start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1 diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 6e4e3d745b..d9206f5bef 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -65,8 +65,8 @@ module MOM_restart !> A structure to store information about restart fields that are no longer used type obsolete_restart - character(len=32) :: field_name !< Name of restart field that is no longer in use - character(len=32) :: replacement_name !< Name of replacement restart field, if applicable + character(len=32) :: field_name !< Name of restart field that is no longer in use + character(len=32) :: replacement_name !< Name of replacement restart field, if applicable end type obsolete_restart !> A restart registry and the control structure for restarts diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 335db29ccb..5829e49ed3 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -320,14 +320,14 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) ISS => CS%ISS if (CS%rotate_index) then - allocate(sfc_state) - call rotate_surface_state(sfc_state_in,CS%Grid_in, sfc_state,CS%Grid,CS%turns) - allocate(fluxes) - call allocate_forcing_type(fluxes_in,G,fluxes) - call rotate_forcing(fluxes_in,fluxes,CS%turns) + allocate(sfc_state) + call rotate_surface_state(sfc_state_in, CS%Grid_in, sfc_state, CS%Grid, CS%turns) + allocate(fluxes) + call allocate_forcing_type(fluxes_in, G, fluxes) + call rotate_forcing(fluxes_in, fluxes, CS%turns) else - sfc_state=>sfc_state_in - fluxes=>fluxes_in + sfc_state => sfc_state_in + fluxes => fluxes_in endif ! useful parameters is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ied = G%ied ; jed = G%jed @@ -759,8 +759,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) call cpu_clock_end(id_clock_shelf) if (CS%rotate_index) then -! call rotate_surface_state(sfc_state,CS%Grid, sfc_state_in,CS%Grid_in,-CS%turns) - call rotate_forcing(fluxes,fluxes_in,-CS%turns) +! call rotate_surface_state(sfc_state,CS%Grid, sfc_state_in,CS%Grid_in,-CS%turns) + call rotate_forcing(fluxes,fluxes_in,-CS%turns) endif @@ -1420,7 +1420,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "ice shelf (every time step) from a file.", default=.false.) if (CS%find_salt_root) then ! read liquidus coeffs. - call get_param(param_file, mdl, "TFREEZE_S0_P0", CS%TFr_0_0, & + call get_param(param_file, mdl, "TFREEZE_S0_P0", CS%TFr_0_0, & "this is the freezing potential temperature at "//& "S=0, P=0.", units="degC", default=0.0, do_not_log=.true.) call get_param(param_file, mdl, "DTFREEZE_DS", CS%dTFr_dS, & @@ -1487,19 +1487,20 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, if (PRESENT(sfc_state_in)) then - allocate(sfc_state) - ! assuming frazil is enabled in ocean. This could break some configurations? - call allocate_surface_state(sfc_state_in, CS%Grid_in, use_temperature=.true.,& - do_integrals=.true.,omit_frazil=.false.,use_iceshelves=.true.) - if (CS%rotate_index) then - call rotate_surface_state(sfc_state_in,CS%Grid_in, sfc_state,CS%Grid,CS%turns) - else - sfc_state=>sfc_state_in - endif + allocate(sfc_state) + ! assuming frazil is enabled in ocean. This could break some configurations? + call allocate_surface_state(sfc_state_in, CS%Grid_in, use_temperature=.true., & + do_integrals=.true., omit_frazil=.false., use_iceshelves=.true.) + if (CS%rotate_index) then + call rotate_surface_state(sfc_state_in, CS%Grid_in, sfc_state,CS%Grid,CS%turns) + else + sfc_state=>sfc_state_in + endif endif - call safe_alloc_ptr(CS%utide,isd,ied,jsd,jed) ; CS%utide(:,:) = 0.0 + call safe_alloc_ptr(CS%utide,isd,ied,jsd,jed) ; CS%utide(:,:) = 0.0 + if (read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & "The path to the file containing the spatially varying "//& @@ -1618,8 +1619,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, endif if (new_sim .and. (.not. (CS%override_shelf_movement .and. CS%mass_from_file))) then - ! This model is initialized internally or from a file. - call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%Grid, CS%Grid_in, US, param_file,& + ! This model is initialized internally or from a file. + call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%Grid, CS%Grid_in, US, param_file,& CS%rotate_index, CS%turns) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed ; do i=G%isd,G%ied @@ -1628,9 +1629,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, endif enddo ; enddo if (CS%debug) then - call hchksum(ISS%mass_shelf, "IS init: mass_shelf", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) - call hchksum(ISS%area_shelf_h, "IS init: area_shelf", G%HI, haloshift=0, scale=US%L_to_m*US%L_to_m) - call hchksum(ISS%hmask, "IS init: hmask", G%HI, haloshift=0) + call hchksum(ISS%mass_shelf, "IS init: mass_shelf", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) + call hchksum(ISS%area_shelf_h, "IS init: area_shelf", G%HI, haloshift=0, scale=US%L_to_m*US%L_to_m) + call hchksum(ISS%hmask, "IS init: hmask", G%HI, haloshift=0) endif ! else ! Previous block for new_sim=.T., this block restores the state. @@ -1666,7 +1667,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, ! do j=G%jsc,G%jec ; do i=G%isc,G%iec ! ISS%area_shelf_h(i,j) = ISS%area_shelf_h(i,j)*G%mask2dT(i,j) -! enddo; enddo +! enddo ; enddo id_clock_shelf = cpu_clock_id('Ice shelf', grain=CLOCK_COMPONENT) id_clock_pass = cpu_clock_id(' Ice shelf halo updates', grain=CLOCK_ROUTINE) @@ -1762,14 +1763,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, CS%id_area_shelf_h = register_diag_field('ice_shelf_model', 'area_shelf_h', CS%diag%axesT1, CS%Time, & - 'Ice Shelf Area in cell', 'meter-2', conversion=US%L_to_m**2) + 'Ice Shelf Area in cell', 'meter-2', conversion=US%L_to_m**2) CS%id_shelf_mass = register_diag_field('ice_shelf_model', 'shelf_mass', CS%diag%axesT1, CS%Time, & - 'mass of shelf', 'kg/m^2', conversion=US%RZ_to_kg_m2) + 'mass of shelf', 'kg/m^2', conversion=US%RZ_to_kg_m2) CS%id_h_shelf = register_diag_field('ice_shelf_model', 'h_shelf', CS%diag%axesT1, CS%Time, & - 'ice shelf thickness', 'm', conversion=US%Z_to_m) + 'ice shelf thickness', 'm', conversion=US%Z_to_m) CS%id_mass_flux = register_diag_field('ice_shelf_model', 'mass_flux', CS%diag%axesT1,& - CS%Time, 'Total mass flux of freshwater across the ice-ocean interface.', & - 'kg/s', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2) + CS%Time, 'Total mass flux of freshwater across the ice-ocean interface.', & + 'kg/s', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2) if (CS%const_gamma) then ! use ISOMIP+ eq. with rho_fw = 1000. kg m-3 meltrate_conversion = 86400.0*365.0*US%Z_to_m*US%s_to_T / (1000.0*US%kg_m3_to_R) @@ -1777,27 +1778,27 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, meltrate_conversion = 86400.0*365.0*US%Z_to_m*US%s_to_T / CS%density_ice endif CS%id_melt = register_diag_field('ice_shelf_model', 'melt', CS%diag%axesT1, CS%Time, & - 'Ice Shelf Melt Rate', 'm yr-1', conversion= meltrate_conversion) + 'Ice Shelf Melt Rate', 'm yr-1', conversion= meltrate_conversion) CS%id_thermal_driving = register_diag_field('ice_shelf_model', 'thermal_driving', CS%diag%axesT1, CS%Time, & - 'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', 'Celsius') + 'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', 'Celsius') CS%id_haline_driving = register_diag_field('ice_shelf_model', 'haline_driving', CS%diag%axesT1, CS%Time, & - 'salinity in the boundary layer minus salinity at the ice-ocean interface.', 'psu') + 'salinity in the boundary layer minus salinity at the ice-ocean interface.', 'psu') CS%id_Sbdry = register_diag_field('ice_shelf_model', 'sbdry', CS%diag%axesT1, CS%Time, & - 'salinity at the ice-ocean interface.', 'psu') + 'salinity at the ice-ocean interface.', 'psu') CS%id_u_ml = register_diag_field('ice_shelf_model', 'u_ml', CS%diag%axesCu1, CS%Time, & - 'Eastward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) + 'Eastward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_ml = register_diag_field('ice_shelf_model', 'v_ml', CS%diag%axesCv1, CS%Time, & - 'Northward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) + 'Northward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_exch_vel_s = register_diag_field('ice_shelf_model', 'exch_vel_s', CS%diag%axesT1, CS%Time, & - 'Sub-shelf salinity exchange velocity', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Sub-shelf salinity exchange velocity', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_exch_vel_t = register_diag_field('ice_shelf_model', 'exch_vel_t', CS%diag%axesT1, CS%Time, & - 'Sub-shelf thermal exchange velocity', 'm s-1' , conversion=US%Z_to_m*US%s_to_T) + 'Sub-shelf thermal exchange velocity', 'm s-1' , conversion=US%Z_to_m*US%s_to_T) CS%id_tfreeze = register_diag_field('ice_shelf_model', 'tfreeze', CS%diag%axesT1, CS%Time, & - 'In Situ Freezing point at ice shelf interface', 'degC') + 'In Situ Freezing point at ice shelf interface', 'degC') CS%id_tfl_shelf = register_diag_field('ice_shelf_model', 'tflux_shelf', CS%diag%axesT1, CS%Time, & - 'Heat conduction into ice shelf', 'W m-2', conversion=-US%QRZ_T_to_W_m2) + 'Heat conduction into ice shelf', 'W m-2', conversion=-US%QRZ_T_to_W_m2) CS%id_ustar_shelf = register_diag_field('ice_shelf_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & - 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m*US%s_to_T) + 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m*US%s_to_T) if (CS%active_shelf_dynamics) then CS%id_h_mask = register_diag_field('ice_shelf_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') @@ -1978,13 +1979,11 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time) if (CS%rotate_index) then - allocate(tmp2d(CS%Grid_in%isc:CS%Grid_in%iec,CS%Grid_in%jsc:CS%Grid_in%jec)); tmp2d(:,:) = 0.0 + allocate(tmp2d(CS%Grid_in%isc:CS%Grid_in%iec,CS%Grid_in%jsc:CS%Grid_in%jec)) ; tmp2d(:,:) = 0.0 else - allocate(tmp2d(is:ie,js:je)) ; tmp2d(:,:) = 0.0 + allocate(tmp2d(is:ie,js:je)) ; tmp2d(:,:) = 0.0 endif - - call time_interp_external(CS%id_read_mass, Time, tmp2d) call rotate_array(tmp2d,CS%turns, ISS%mass_shelf) deallocate(tmp2d) @@ -2026,21 +2025,17 @@ subroutine ice_shelf_query(CS, G, frac_shelf_h) real, optional, dimension(SZI_(G),SZJ_(G)) :: frac_shelf_h !< !< Ice shelf area fraction [nodim]. - logical :: do_frac=.false. - integer :: i,j - - if (present(frac_shelf_h)) do_frac=.true. + integer :: i, j - if (do_frac) then - do j=G%jsd,G%jed - do i=G%isd,G%ied - frac_shelf_h(i,j)=0.0 - if (G%areaT(i,j)>0.) frac_shelf_h(i,j) = CS%ISS%area_shelf_h(i,j) / G%areaT(i,j) - enddo - enddo - endif + if (present(frac_shelf_h)) then + do j=G%jsd,G%jed ; do i=G%isd,G%ied + frac_shelf_h(i,j) = 0.0 + if (G%areaT(i,j)>0.) frac_shelf_h(i,j) = CS%ISS%area_shelf_h(i,j) / G%areaT(i,j) + enddo ; enddo + endif end subroutine ice_shelf_query + !> Save the ice shelf restart file subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_suffix) type(ice_shelf_CS), pointer :: CS !< ice shelf control structure diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 5db9646dae..547f9e6812 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -154,18 +154,18 @@ subroutine set_axes_info(G, param_file, diag_cs, axes_set_name) endif if (G%symmetric) then - id_xq = diag_axis_init('xB', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & + id_xq = diag_axis_init('xB', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & 'Boundary point nominal longitude',set_name=set_name, & Domain2=G%Domain%mpp_domain, domain_position=EAST) - id_yq = diag_axis_init('yB', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & + id_yq = diag_axis_init('yB', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & 'Boundary point nominal latitude', set_name=set_name, & Domain2=G%Domain%mpp_domain, domain_position=NORTH) else - id_xq = diag_axis_init('xB', G%gridLonB(G%isg:G%ieg), G%x_axis_units, 'x', & + id_xq = diag_axis_init('xB', G%gridLonB(G%isg:G%ieg), G%x_axis_units, 'x', & 'Boundary point nominal longitude',set_name=set_name, & Domain2=G%Domain%mpp_domain, domain_position=EAST) - id_yq = diag_axis_init('yB', G%gridLatB(G%jsg:G%jeg), G%y_axis_units, 'y', & + id_yq = diag_axis_init('yB', G%gridLatB(G%jsg:G%jeg), G%y_axis_units, 'y', & 'Boundary point nominal latitude', set_name=set_name, & Domain2=G%Domain%mpp_domain, domain_position=NORTH) @@ -428,8 +428,8 @@ end function get_diag_time_end !> Returns the "MOM_IS_diag_mediator" handle for a group of diagnostics derived from one field. function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, conversion) result (register_diag_field) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count, conversion) result (register_diag_field) integer :: register_diag_field !< The returned diagnostic handle character(len=*), intent(in) :: module_name !< Name of this module, usually "ice_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -524,8 +524,8 @@ end function register_MOM_IS_diag_field !> Registers a static diagnostic, returning an integer handle function register_static_field(module_name, field_name, axes, & - long_name, units, missing_value, range, mask_variant, standard_name, & - do_not_log, interp_method, tile_count) + long_name, units, missing_value, range, mask_variant, standard_name, & + do_not_log, interp_method, tile_count) integer :: register_static_field !< The returned diagnostic handle character(len=*), intent(in) :: module_name !< Name of this module, usually "ice_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -599,8 +599,8 @@ function i2s(a, n_in) i2s = '' do i=1,n - write (i2s_temp, '(I4.4)') a(i) - i2s = trim(i2s) //'_'// trim(i2s_temp) + write (i2s_temp, '(I4.4)') a(i) + i2s = trim(i2s) //'_'// trim(i2s_temp) enddo i2s = adjustl(i2s) end function i2s diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index f038190753..decdbf2e92 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -2788,9 +2788,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 if (G%symmetric) then - is = isd ; js = jsd + is = isd ; js = jsd else - is = isd+1 ; js = jsd+1 + is = isd+1 ; js = jsd+1 endif do j=js,G%jed diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 90c98fa487..9fe8028ac6 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -58,28 +58,26 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, P if (PRESENT(rotate_index)) rotate=rotate_index if (rotate) then - allocate(tmp1_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed));tmp1_2d(:,:)=0.0 - allocate(tmp2_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed));tmp2_2d(:,:)=0.0 - allocate(tmp3_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed));tmp3_2d(:,:)=0.0 - select case ( trim(config) ) - case ("CHANNEL"); call initialize_ice_thickness_channel (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) - case ("FILE"); call initialize_ice_thickness_from_file (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) - case ("USER"); call USER_init_ice_thickness (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) - case default ; call MOM_error(FATAL,"MOM_initialize: "// & - "Unrecognized ice profile setup "//trim(config)) - end select - call rotate_array(tmp1_2d,turns, h_shelf) - call rotate_array(tmp2_2d,turns, area_shelf_h) - call rotate_array(tmp3_2d,turns, hmask) - deallocate(tmp1_2d,tmp2_2d,tmp3_2d) + allocate(tmp1_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp1_2d(:,:)=0.0 + allocate(tmp2_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp2_2d(:,:)=0.0 + allocate(tmp3_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp3_2d(:,:)=0.0 + select case ( trim(config) ) + case ("CHANNEL") ; call initialize_ice_thickness_channel (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) + case ("FILE") ; call initialize_ice_thickness_from_file (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) + case ("USER") ; call USER_init_ice_thickness (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) + case default ; call MOM_error(FATAL,"MOM_initialize: Unrecognized ice profile setup "//trim(config)) + end select + call rotate_array(tmp1_2d,turns, h_shelf) + call rotate_array(tmp2_2d,turns, area_shelf_h) + call rotate_array(tmp3_2d,turns, hmask) + deallocate(tmp1_2d,tmp2_2d,tmp3_2d) else - select case ( trim(config) ) - case ("CHANNEL"); call initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, US, PF) - case ("FILE"); call initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, US, PF) - case ("USER"); call USER_init_ice_thickness (h_shelf, area_shelf_h, hmask, G, US, PF) - case default ; call MOM_error(FATAL,"MOM_initialize: "// & - "Unrecognized ice profile setup "//trim(config)) - end select + select case ( trim(config) ) + case ("CHANNEL") ; call initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, US, PF) + case ("FILE") ; call initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, US, PF) + case ("USER") ; call USER_init_ice_thickness (h_shelf, area_shelf_h, hmask, G, US, PF) + case default ; call MOM_error(FATAL,"MOM_initialize: Unrecognized ice profile setup "//trim(config)) + end select endif end subroutine initialize_ice_thickness diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 54b452fc6a..122758f3cc 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -149,51 +149,52 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C do j=G%jsd,G%jed - if (((j+G%jdg_offset) <= G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+G%jdg_offset) >= G%domain%njhalo+1)) then + if (((j+G%jdg_offset) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+G%jdg_offset) >= G%domain%njhalo+1)) then - do i=G%isc,G%iec + do i=G%isc,G%iec ! if (((i+G%idg_offset) <= G%domain%niglobal+G%domain%nihalo) .AND. & ! ((i+G%idg_offset) >= G%domain%nihalo+1)) then - if ((j >= G%jsc) .and. (j <= G%jec)) then - - if (new_sim) then ; if (G%geoLonCu(i-1,j) >= edge_pos) then - ! Everything past the edge is open ocean. - mass_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - hmask (i,j) = 0.0 - h_shelf (i,j) = 0.0 - else - if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & - (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) - hmask (i,j) = 2.0 - else - area_shelf_h(i,j) = G%areaT(i,j) - hmask (i,j) = 1.0 + if ((j >= G%jsc) .and. (j <= G%jec)) then + if (new_sim) then ; if (G%geoLonCu(i-1,j) >= edge_pos) then + ! Everything past the edge is open ocean. + mass_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + hmask (i,j) = 0.0 + h_shelf (i,j) = 0.0 + else + if (G%geoLonCu(i,j) > edge_pos) then + area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) + hmask (i,j) = 2.0 + else + area_shelf_h(i,j) = G%areaT(i,j) + hmask (i,j) = 1.0 + endif + + if (G%geoLonT(i,j) > slope_pos) then + h_shelf (i,j) = CS%min_draft + mass_shelf(i,j) = CS%Rho_ocean * CS%min_draft + else + mass_shelf(i,j) = CS%Rho_ocean * (CS%min_draft + & + (CS%max_draft - CS%min_draft) * & + min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) + h_shelf(i,j) = (CS%min_draft + & + (CS%max_draft - CS%min_draft) * & + min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) + endif + endif ; endif endif - if (G%geoLonT(i,j) > slope_pos) then - h_shelf (i,j) = CS%min_draft - mass_shelf(i,j) = CS%Rho_ocean * CS%min_draft - else - mass_shelf(i,j) = CS%Rho_ocean * (CS%min_draft + & - (CS%max_draft - CS%min_draft) * & - min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) - h_shelf(i,j) = (CS%min_draft + & - (CS%max_draft - CS%min_draft) * & - min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) + if ((i+G%idg_offset) == G%domain%nihalo+1) then + hmask(i-1,j) = 3.0 endif - endif ; endif ; endif - - if ((i+G%idg_offset) == G%domain%nihalo+1) then - hmask(i-1,j) = 3.0 + enddo endif - - enddo ; endif ; enddo + enddo end subroutine USER_update_shelf_mass diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 2c9445ae3e..4526d9e9c7 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -240,13 +240,13 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) global_indices(4) = SGdom%njglobal+SGdom%njhalo exni(:) = 2*exni(:) ; exnj(:) = 2*exnj(:) if (associated(G%domain%maskmap)) then - call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & + call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & xextent=exni,yextent=exnj, & symmetry=.true., name="MOM_MOSAIC", maskmap=G%domain%maskmap) else - call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & + call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & xextent=exni,yextent=exnj, & diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 95a97cf8ec..ec51a045cf 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1311,9 +1311,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call create_file(unit, trim(filepath), vars, nFlds_used, fields, & file_threading, dG=G) - do J=Jsq,Jeq; do I=Isq,Ieq; out_q(I,J) = G%geoLatBu(I,J); enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%geoLatBu(I,J) ; enddo ; enddo call write_field(unit, fields(1), G%Domain%mpp_domain, out_q) - do J=Jsq,Jeq; do I=Isq,Ieq; out_q(I,J) = G%geoLonBu(I,J); enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%geoLonBu(I,J) ; enddo ; enddo call write_field(unit, fields(2), G%Domain%mpp_domain, out_q) call write_field(unit, fields(3), G%Domain%mpp_domain, G%geoLatT) call write_field(unit, fields(4), G%Domain%mpp_domain, G%geoLonT) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 317cd7c096..f616f09e10 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -117,13 +117,13 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: u !< The zonal velocity that is being !! initialized [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: v !< The meridional velocity that is being !! initialized [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables @@ -179,7 +179,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 @@ -218,7 +218,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This initialization should not be needed. Certainly restricting it ! to the computational domain helps detect possible uninitialized ! data in halos which should be covered by the pass_var(h) later. - !do k = 1, nz; do j = js, je; do i = is, ie + !do k=1,nz ; do j=js,je ; do i=is,ie ! h(i,j,k) = 0. !enddo endif @@ -270,55 +270,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). @@ -348,13 +348,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) @@ -376,7 +376,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)) @@ -384,7 +384,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) @@ -403,22 +403,22 @@ 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, & + 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, & + 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: "//& + case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) end select @@ -561,7 +561,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This controls user code for setting open boundary data if (associated(OBC)) then - call initialize_segment_data(G, OBC, PF) ! call initialize_segment_data(G, OBC, param_file) + call initialize_segment_data(G, OBC, PF) ! call initialize_segment_data(G, OBC, param_file) ! call open_boundary_config(G, US, PF, OBC) ! Call this once to fill boundary arrays from fixed values if (.not. OBC%needs_IO_for_data) & @@ -589,17 +589,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 @@ -635,7 +635,7 @@ subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thi !! only read parameters without changing h. ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! Interface heights, in depth units. + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units. integer :: inconsistent = 0 logical :: correct_thickness logical :: just_read ! If true, just read parameters but set nothing. @@ -643,7 +643,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 @@ -713,18 +713,18 @@ end subroutine initialize_thickness_from_file !! @remark{There is a (hard-wired) "tolerance" parameter such that the !! criteria for adjustment must equal or exceed 10cm.} subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) - 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)+1), intent(inout) :: eta !< Interface heights [Z ~> m]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: eta !< Interface heights [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] 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 @@ -797,14 +797,14 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units, usually + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units, usually ! negative because it is positive upward. - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units. 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 @@ -853,16 +853,16 @@ subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path 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 @@ -926,7 +926,7 @@ subroutine convert_thickness(h, G, GV, US, tv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Input geometric layer thicknesses being converted !! to layer pressure [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -944,7 +944,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 @@ -1001,7 +1001,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, 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 type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -1010,7 +1010,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & eta_sfc ! The free surface height that the model should use [Z ~> m]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & eta ! The free surface height that the model should use [Z ~> m]. real :: dilate ! A ratio by which layers are dilated [nondim]. real :: scale_factor ! A scaling factor for the eta_sfc values that are read @@ -1020,7 +1020,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 @@ -1088,15 +1088,15 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ALE_CS), pointer :: ALE_CSp !< ALE control structure type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables character(len=200) :: mdl = "trim_for_ice" real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface [R L2 T-2 ~> Pa] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity [ppt] and temperature [degC] within each layer. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S_t, S_b ! Top and bottom edge values for reconstructions + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T_t, T_b ! of salinity [ppt] and temperature [degC] within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor ! A file-dependent scaling factor for the input pressure. real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. @@ -1153,7 +1153,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 @@ -1271,11 +1271,12 @@ 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to @@ -1312,11 +1313,12 @@ 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. @@ -1326,7 +1328,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 @@ -1346,11 +1348,12 @@ 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to @@ -1362,7 +1365,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 @@ -1387,17 +1390,18 @@ 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing u or v. ! Local variables character(len=200) :: mdl = "initialize_velocity_circular" real :: circular_max_u ! The amplitude of the zonal flow [L T-1 ~> m s-1] @@ -1405,7 +1409,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 @@ -1450,15 +1454,16 @@ 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 - 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 - !! being initialized [ppt] +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_(GV)), intent(out) :: T !< The potential temperature that is + !! being initialized [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is + !! being initialized [ppt] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing T or S. ! Local variables logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, salt_filename ! Full paths to input files @@ -1506,17 +1511,18 @@ 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) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 - !! being initialized [ppt] +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_(GV)), intent(out) :: T !< The potential temperature that is + !! being initialized [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is + !! being initialized [ppt] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing T or S. ! Local variables - real, dimension(SZK_(G)) :: T0, S0 + real, dimension(SZK_(GV)) :: T0, S0 integer :: i, j, k logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, ts_file, inputdir ! Strings for file/path @@ -1543,7 +1549,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 @@ -1554,9 +1560,9 @@ end subroutine initialize_temp_salt_from_profile subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P_Ref, 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), 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 being + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being !! initialized [ppt]. 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 @@ -1565,21 +1571,21 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing T or S. ! Local variables - real :: T0(SZK_(G)) ! Layer potential temperatures [degC] - real :: S0(SZK_(G)) ! Layer salinities [degC] + real :: T0(SZK_(GV)) ! Layer potential temperatures [degC] + real :: S0(SZK_(GV)) ! Layer salinities [degC] real :: T_Ref ! Reference Temperature [degC] real :: S_Ref ! Reference Salinity [ppt] - real :: pres(SZK_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. + real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. 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 @@ -1645,18 +1651,18 @@ 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 - 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 - !! being initialized [ppt] - type(param_file_type), intent(in) :: param_file !< A structure to parse for - !! run-time parameters - logical, optional, intent(in) :: just_read_params !< If present and true, - !! this call will only read - !! parameters without - !! changing h. +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_(GV)), intent(out) :: T !< The potential temperature that is + !! being initialized [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is + !! being initialized [ppt] + type(param_file_type), intent(in) :: param_file !< A structure to parse for + !! run-time parameters + logical, optional, intent(in) :: just_read_params !< If present and true, + !! this call will only read parameters + !! without changing T or S. integer :: k real :: delta_S, delta_T @@ -1685,24 +1691,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 @@ -1730,7 +1736,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L real, allocatable, dimension(:,:,:) :: eta ! The target interface heights [Z ~> m]. real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses [H ~> m or kg m-2]. - real, dimension (SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension (SZI_(G),SZJ_(G),SZK_(GV)) :: & tmp, tmp2 ! A temporary array for tracers. real, dimension (SZI_(G),SZJ_(G)) :: & tmp_2d ! A temporary array for tracers. @@ -1755,7 +1761,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 @@ -1787,9 +1793,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L "performs on-the-fly regridding in lat-lon-time.",& "of sponge restoring data.", default=.false.) if (time_space_interp_sponge) then - call MOM_error(WARNING, " initialize_sponges: NEW_SPONGES has been deprecated. "//& - "Please use INTERPOLATE_SPONGE_TIME_SPACE instead. Setting "//& - "INTERPOLATE_SPONGE_TIME_SPACE = True.") + call MOM_error(WARNING, " initialize_sponges: NEW_SPONGES has been deprecated. "//& + "Please use INTERPOLATE_SPONGE_TIME_SPACE instead. Setting "//& + "INTERPOLATE_SPONGE_TIME_SPACE = True.") endif call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & "Set True if using the newer sponging code which "//& @@ -1858,9 +1864,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L ! The remaining calls to set_up_sponge_field can be in any order. if ( use_temperature) then call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain) - call set_up_sponge_field(tmp, tv%T, G, nz, Layer_CSp) + call set_up_sponge_field(tmp, tv%T, G, GV, nz, Layer_CSp) call MOM_read_data(filename, salin_var, tmp(:,:,:), G%Domain) - call set_up_sponge_field(tmp, tv%S, G, nz, Layer_CSp) + call set_up_sponge_field(tmp, tv%S, G, GV, nz, Layer_CSp) endif endif @@ -1882,23 +1888,23 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z enddo ; enddo ; enddo - do k=1,nz; do j=js,je ; do i=is,ie + 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 allocate(tmp_tr(isd:ied,jsd:jed,nz_data)) call MOM_read_data(filename, potemp_var, tmp_tr(:,:,:), G%Domain) - call set_up_ALE_sponge_field(tmp_tr, G, tv%T, ALE_CSp) + call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%T, ALE_CSp) call MOM_read_data(filename, salin_var, tmp_tr(:,:,:), G%Domain) - call set_up_ALE_sponge_field(tmp_tr, G, tv%S, ALE_CSp) + call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%S, ALE_CSp) deallocate(tmp_tr) 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) @@ -1972,19 +1978,19 @@ end subroutine set_velocity_depth_min !! a latitude-longitude grid. subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_params, frac_shelf_h) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< Layer thicknesses being initialized [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables including temperature and salinity - 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) :: PF !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing T or S. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: frac_shelf_h !< The fraction of the grid cell covered - !! by a floating ice shelf [nondim]. + optional, intent(in) :: frac_shelf_h !< The fraction of the grid cell covered + !! by a floating ice shelf [nondim]. ! Local variables character(len=200) :: filename !< The name of an input file containing temperature @@ -2037,7 +2043,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:), allocatable :: Rb ! Interface densities [R ~> kg m-3] real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: zi ! Interface heights [Z ~> m]. integer, dimension(SZI_(G),SZJ_(G)) :: nlevs real, dimension(SZI_(G)) :: press ! Pressures [R L2 T-2 ~> Pa]. @@ -2070,7 +2076,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 @@ -2343,8 +2349,8 @@ 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, nlevs, nkml, Hmix_depth, & - eps_z, eps_rho, density_extrap_bug) + call find_interfaces(rho_z, z_in, kd, Rb, G%bathyT, zi, G, GV, US, nlevs, nkml, & + Hmix_depth, eps_z, eps_rho, density_extrap_bug) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, US, zi, h) @@ -2411,7 +2417,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) @@ -2429,17 +2435,18 @@ 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, density_extrap_bug) 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] real, dimension(nk_data), intent(in) :: zin !< Input data levels [Z ~> m]. - real, dimension(SZK_(G)+1), intent(in) :: Rb !< target interface densities [R ~> kg m-3] + real, dimension(SZK_(GV)+1), intent(in) :: Rb !< target interface densities [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth !< ocean depth [Z ~> m]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: zi !< The returned interface heights [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, dimension(SZI_(G),SZJ_(G)), & @@ -2457,7 +2464,7 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, depth, zi, G, US, nlevs, nkml, ! Local variables real, dimension(nk_data) :: rho_ ! A column of densities [R ~> kg m-3] - real, dimension(SZK_(G)+1) :: zi_ ! A column interface heights (negative downward) [Z ~> m]. + real, dimension(SZK_(GV)+1) :: zi_ ! A column interface heights (negative downward) [Z ~> m]. real :: slope ! The rate of change of height with density [Z R-1 ~> m4 kg-1] real :: drhodz ! A local vertical density gradient [R Z-1 ~> kg m-4] real, parameter :: zoff=0.999 @@ -2467,7 +2474,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 12235ddd87..48b67bf295 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -39,7 +39,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized type(param_file_type), intent(in) :: PF !< parameter file @@ -88,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/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index acc316cce4..670be5d3fb 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -139,7 +139,7 @@ subroutine init_oda(Time, G, GV, CS) character(len=200) :: inputdir, basin_file logical :: reentrant_x, reentrant_y, tripolar_N, symmetric - if (associated(CS)) call mpp_error(FATAL,'Calling oda_init with associated control structure') + if (associated(CS)) call mpp_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) ! Use ens1 parameters , this could be changed at a later time ! if it were desirable to have alternate parameters, e.g. for the grid @@ -175,14 +175,14 @@ subroutine init_oda(Time, G, GV, CS) inputdir = slasher(inputdir) select case(lowercase(trim(assim_method))) - case('eakf') + case('eakf') CS%assim_method = EAKF_ASSIM - case('oi') - CS%assim_method = OI_ASSIM - case('no_assim') + case('oi') + CS%assim_method = OI_ASSIM + case('no_assim') CS%assim_method = NO_ASSIM - case default - call mpp_error(FATAL,'Invalid assimilation method provided') + case default + call mpp_error(FATAL, 'Invalid assimilation method provided') end select ens_info = get_ensemble_size() @@ -192,8 +192,8 @@ subroutine init_oda(Time, G, GV, CS) !! Switch to global pelist allocate(CS%ensemble_pelist(CS%ensemble_size,npes_pm)) allocate(CS%filter_pelist(CS%ensemble_size*npes_pm)) - call get_ensemble_pelist(CS%ensemble_pelist,'ocean') - call get_ensemble_filter_pelist(CS%filter_pelist,'ocean') + call get_ensemble_pelist(CS%ensemble_pelist, 'ocean') + call get_ensemble_filter_pelist(CS%filter_pelist, 'ocean') call set_current_pelist(CS%filter_pelist) @@ -283,7 +283,7 @@ subroutine init_oda(Time, G, GV, CS) do k = 1, CS%nk call mpp_global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) - do i=1, CS%ni; do j=1, CS%nj + do i=1,CS%ni ; do j=1,CS%nj if ( global2D(i,j) > 1 ) then T_grid%mask(i,j,k) = 1.0 endif @@ -308,7 +308,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model 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] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ODA_CS), pointer :: CS !< ocean DA control structure @@ -337,7 +337,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) allocate(T(isd:ied,jsd:jed,CS%nk)) allocate(S(isd:ied,jsd:jed,CS%nk)) - do j=js,je; do i=is,ie + do j=js,je ; do i=is,ie call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), & CS%nk, CS%h(i,j,:), T(i,j,:)) call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), & @@ -525,11 +525,12 @@ end subroutine save_obs_diff !> Apply increments to tracers -subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) +subroutine apply_oda_tracer_increments(dt, G, GV, tv, h, CS) real, intent(in) :: dt !< The tracer timestep [s] type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] type(ODA_CS), intent(inout) :: CS !< the data assimilation structure diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index b67f8fd009..850f94cff2 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -113,14 +113,14 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -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 119a457bc0..ed3ef7173e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -217,16 +217,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, CS, OBC, BT, TD, ADp) 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)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: diffu !< Zonal acceleration due to convergence of !! along-coordinate stress tensor [L T-2 ~> m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: diffv !< Meridional acceleration due to convergence !! of along-coordinate stress tensor [L T-2 ~> m s-2]. type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields @@ -302,7 +302,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, grad_vel_mag_bt_q, & ! Magnitude of the barotropic velocity gradient tensor squared at q-points [T-2 ~> s-2] boundary_mask_q ! A mask that zeroes out cells with at least one land edge [nondim] - real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & Ah_q, & ! biharmonic viscosity at corner points [L4 T-1 ~> m4 s-1] Kh_q, & ! Laplacian viscosity at corner points [L2 T-1 ~> m2 s-1] vort_xy_q, & ! vertical vorticity at corner points [T-1 ~> s-1] @@ -310,11 +310,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, GME_coeff_q, & !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] max_diss_rate_q, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] ShSt ! A diagnostic array of shear stress [T-1 ~> s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: & KH_u_GME !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: & KH_v_GME !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] max_diss_rate_h, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] @@ -323,7 +323,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx_h, & ! horizontal divergence [T-1 ~> s-1] sh_xx_h, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] NoSt ! A diagnostic array of normal stress [T-1 ~> s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & grid_Re_Kh, & !< Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim] grid_Re_Ah, & !< Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim] GME_coeff_h !< GME coeff. at h-points [L2 T-1 ~> m2 s-1] @@ -374,7 +374,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 @@ -427,7 +427,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 boundary_mask_q(I,J) = (G%mask2dCv(i,J) * G%mask2dCv(i+1,J) * G%mask2dCu(I,j) * G%mask2dCu(I,j-1)) - enddo; enddo + enddo ; enddo ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 @@ -444,7 +444,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, G%IdyCu(I-1,j) * ubtav(I-1,j)) dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) - enddo; enddo + enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) @@ -693,7 +693,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Del2v(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) enddo ; enddo - if (apply_OBC) then; if (OBC%zero_biharmonic) then + if (apply_OBC) then ; if (OBC%zero_biharmonic) then do n=1,OBC%number_of_segments I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%is_N_or_S .and. (J >= Jsq-1) .and. (J <= Jeq+1)) then @@ -706,7 +706,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo endif enddo - endif; endif + endif ; endif endif ! Vorticity @@ -1132,7 +1132,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 @@ -1421,9 +1421,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. @@ -1486,7 +1487,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 @@ -2094,30 +2095,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 @@ -2233,7 +2234,8 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) + we * GME_flux_h_original(i+1,j) & + ws * GME_flux_h_original(i,j-1) & + wn * GME_flux_h_original(i,j+1) - enddo; enddo + enddo + enddo endif ! Update halos if (present(GME_flux_q)) then @@ -2255,7 +2257,8 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) + we * GME_flux_q_original(I+1,J) & + ws * GME_flux_q_original(I,J-1) & + wn * GME_flux_q_original(I,J+1) - enddo; enddo + enddo + enddo endif enddo ! s-loop end subroutine smooth_GME diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 5d0cce3cd8..80543d5968 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -155,7 +155,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables !! (needed for wave structure). @@ -2392,7 +2392,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) endif call pass_var(ridge_temp,G%domain) allocate(CS%refl_dbl(isd:ied,jsd:jed)) ; CS%refl_dbl(:,:) = .false. - do i=isd,ied; do j=jsd,jed + do i=isd,ied ; do j=jsd,jed if (ridge_temp(i,j) == 1) then; CS%refl_dbl(i,j) = .true. else ; CS%refl_dbl(i,j) = .false. ; endif enddo ; enddo @@ -2548,7 +2548,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..e3a6f1599e 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -188,12 +188,12 @@ end subroutine calc_depth_function !> Calculates and stores the non-dimensional resolution functions subroutine calc_resoln_function(h, tv, G, GV, US, CS) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some @@ -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:"// & @@ -434,19 +434,19 @@ end subroutine calc_resoln_function !> Calculates and stores functions of isopycnal slopes, e.g. Sx, Sy, S*N, mostly used in the Visbeck et al. !! style scaling of diffusivity subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: dt !< Time increment [T ~> s] - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, intent(in) :: dt !< Time increment [T ~> s] + type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables - real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & + real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [T-2 ~> s-2] - real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [T-2 ~> s-2] + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [T-2 ~> s-2] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [T-2 ~> s-2] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") @@ -479,18 +479,18 @@ end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS, OBC) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency - !! at u-points [T-2 ~> s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency - !! at v-points [T-2 ~> s-2] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: slope_x !< Zonal isoneutral slope + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency + !! at u-points [T-2 ~> s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: slope_y !< Meridional isoneutral slope + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency + !! at v-points [T-2 ~> s-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: S2 ! Interface slope squared [nondim] @@ -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. @@ -644,15 +644,15 @@ end subroutine calc_Visbeck_coeffs !> The original calc_slope_function() that calculated slopes using !! interface positions only, not accounting for density variations. subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slopes, OBC) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position [Z ~> m] - logical, intent(in) :: calculate_slopes !< If true, calculate slopes internally - !! otherwise use slopes stored in CS - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface position [Z ~> m] + logical, intent(in) :: calculate_slopes !< If true, calculate slopes + !! internally otherwise use slopes stored in CS + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) @@ -667,8 +667,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop integer :: is, ie, js, je, nz integer :: i, j, k, kb_max integer :: l_seg - real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(G)) - real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(G)) + real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(GV)) + real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(GV)) logical :: local_open_u_BC, local_open_v_BC if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & @@ -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. @@ -809,7 +809,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence !! (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] @@ -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.", & @@ -1105,10 +1105,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) - enddo; enddo + enddo ; enddo do J=js-1,Jeq ; do i=is,ie CS%L2v(i,J) = CS%Visbeck_L_scale**2 * G%areaCv(i,J) - enddo; enddo + enddo ; enddo else CS%L2u(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 CS%L2v(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 @@ -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..b370332d90 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -88,21 +88,21 @@ module MOM_mixed_layer_restrat !! The code branches between two different implementations depending !! on whether the bulk-mixed layer or a general coordinate are in use. subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H L2 ~> m3 or kg] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [T ~> s] - real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the - !! PBL scheme [Z ~> m] - type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [H L2 ~> m3 or kg] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, intent(in) :: dt !< Time increment [T ~> s] + real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the + !! PBL scheme [Z ~> m] + type(VarMix_CS), pointer :: VarMix !< Container for derived fields + type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "Module must be initialized before it is used.") @@ -118,25 +118,25 @@ end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer. subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) ! Arguments - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H L2 ~> m3 or kg] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [T ~> s] - real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the - !! PBL scheme [Z ~> m] (not H) - type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [H L2 ~> m3 or kg] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, intent(in) :: dt !< Time increment [T ~> s] + real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the + !! PBL scheme [Z ~> m] (not H) + type(VarMix_CS), pointer :: VarMix !< Container for derived fields + type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -159,11 +159,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] - real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux + real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. - real :: b(SZK_(G)) ! As for a(k) but for the slow-filtered MLD + real :: b(SZK_(GV)) ! As for a(k) but for the slow-filtered MLD real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper @@ -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: "// & @@ -560,22 +560,22 @@ end subroutine mixedlayer_restrat_general !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H L2 ~> m3 or kg] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [T ~> s] - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [H L2 ~> m3 or kg] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, intent(in) :: dt !< Time increment [T ~> s] + type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -596,7 +596,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] real :: hx2 ! layer thickness at velocity points [H ~> m or kg m-2] - real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux + real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. @@ -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: "// & @@ -664,7 +664,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! U - Component !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) @@ -707,7 +707,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) uDml_diag(I,j) = uDml(I) utimescale_diag(I,j) = timescale - enddo; enddo + enddo ; enddo ! V- component !$OMP do @@ -753,7 +753,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) vtimescale_diag(i,J) = timescale vDml_diag(i,J) = vDml(i) - enddo; enddo + enddo ; enddo !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 16d9294308..8c6a90ba9c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -106,39 +106,39 @@ module MOM_thickness_diffuse !! thicknesses, h. Diffusivities are limited to ensure stability. !! Also returns along-layer mass fluxes used in the continuity equation. subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp, CS) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [L2 H ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [L2 H ~> m3 or kg] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE control structure - type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients - type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [L2 H ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [L2 H ~> m3 or kg] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + real, intent(in) :: dt !< Time increment [T ~> s] + type(MEKE_type), pointer :: MEKE !< MEKE control structure + type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients + type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation + type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion ! Local variables - real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean + real :: e(SZI_(G), SZJ_(G),SZK_(GV)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. - real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] - real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] + real :: uhD(SZIB_(G), SZJ_(G),SZK_(GV)) ! Diffusive u*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] + real :: vhD(SZI_(G), SZJB_(G),SZK_(GV)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: & KH_u, & ! interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures [nondim]. - real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: & + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: & KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures [nondim]. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G), SZJ_(G)) :: & @@ -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 @@ -213,7 +213,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP int_slope_v,khth_use_ebt_struct, Depth_scaled, & !$OMP Khth_loc_v) !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = CS%Khth enddo ; enddo @@ -244,31 +244,31 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = Khth_loc_u(I,j) * VarMix%Res_fn_u(I,j) enddo ; enddo endif if (Depth_scaled) then !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = Khth_loc_u(I,j) * VarMix%Depth_fn_u(I,j) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = max(CS%Khth_Min, min(Khth_loc_u(I,j), CS%Khth_Max)) enddo ; enddo else !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = max(CS%Khth_Min, Khth_loc_u(I,j)) enddo ; enddo endif !$OMP do - do j=js,je; do I=is-1,ie + do j=js,je ; do I=is-1,ie KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_loc_u(I,j)) enddo ; enddo @@ -330,7 +330,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do - do J=js-1,je; do i=is,ie + do J=js-1,je ; do i=is,ie Khth_loc_v(i,J) = Khth_loc_v(i,J) * VarMix%Res_fn_v(i,J) enddo ; enddo endif @@ -501,7 +501,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp do k=1,nz do j=js,je ; do i=is,ie MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + Kh_t(i,j,k) * h(i,j,k) - enddo; enddo + enddo ; enddo enddo do j=js,je ; do i=is,ie @@ -552,36 +552,36 @@ end subroutine thickness_diffuse !! Called by thickness_diffuse(). subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, & CS, int_slope_u, int_slope_v, slope_x, slope_y) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface positions [Z ~> m] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points [L2 T-1 ~> m2 s-1] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: uhD !< Zonal mass fluxes !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: vhD !< Meridional mass fluxes !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] - real, intent(in) :: dt !< Time increment [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE control structure - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of + real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] + real, intent(in) :: dt !< Time increment [T ~> s] + type(MEKE_type), pointer :: MEKE !< MEKE control structure + type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of !! density gradients [nondim]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of !! density gradients [nondim]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points ! Local variables - real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & T, & ! The temperature (or density) [degC], with the values in ! in massless layers filled vertically by diffusion. S, & ! The filled salinity [ppt], with the values in @@ -590,15 +590,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer [nondim]. 0 m s-2], ! used for calculating PE release - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: & Slope_x_PE, & ! 3D array of neutral slopes at u-points, set equal to Slope (below, nondim) hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [L2 Z-1 T-2 ~> m s-2], ! used for calculating PE release - real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & + real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & pres, & ! The pressure at an interface [R L2 T-2 ~> Pa]. h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & @@ -630,12 +630,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [R ~> kg m-3]. real :: drdkL, drdkR ! Vertical density differences across an interface [R ~> kg m-3]. - real :: drdi_u(SZIB_(G), SZK_(G)) ! Copy of drdi at u-points [R ~> kg m-3]. - real :: drdj_v(SZI_(G), SZK_(G)) ! Copy of drdj at v-points [R ~> kg m-3]. - real :: drdkDe_u(SZIB_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points - ! [Z R ~> kg m-2]. - real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points - ! [Z R ~> kg m-2]. + real :: drdi_u(SZIB_(G),SZK_(GV)) ! Copy of drdi at u-points [R ~> kg m-3]. + real :: drdj_v(SZI_(G), SZK_(GV)) ! Copy of drdj at v-points [R ~> kg m-3]. + real :: drdkDe_u(SZIB_(G),SZK_(GV)+1) ! Lateral difference of product of drdk and e at u-points + ! [Z R ~> kg m-2]. + real :: drdkDe_v(SZI_(G),SZK_(GV)+1) ! Lateral difference of product of drdk and e at v-points + ! [Z R ~> kg m-2]. real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. @@ -643,16 +643,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: drdx, drdy ! Zonal and meridional density gradients [R L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. - real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2]. - real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. - real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [L2 Z-1 T-2 ~> m s-2]. - real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2]. + real :: c2_h_u(SZIB_(G),SZK_(GV)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2]. + real :: c2_h_v(SZI_(G),SZK_(GV)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_u(SZIB_(G),SZK_(GV)+1) ! Thickness in m times N2 at interfaces above u-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_v(SZI_(G),SZK_(GV)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2]. real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning ! streamfunction [Z L2 T-1 ~> m3 s-1]. - real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1]. - real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1]. - real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. - real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. + real :: Sfn_unlim_u(SZIB_(G),SZK_(GV)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_v(SZI_(G),SZK_(GV)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1]. + real :: slope2_Ratio_u(SZIB_(G),SZK_(GV)+1) ! The ratio of the slope squared to slope_max squared. + real :: slope2_Ratio_v(SZI_(G),SZK_(GV)+1) ! The ratio of the slope squared to slope_max squared. real :: Sfn_in_h ! The overturning streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] (note that ! the units are different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a @@ -680,10 +680,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: mn_T2 ! mean of T**2 in local stencil [degC] real :: hl(5) ! Copy of local stencil of H [H ~> m] real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1] - real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tsgs2 ! Sub-grid temperature variance [degC2] + real, dimension(SZI_(G), SZJ_(G),SZK_(GV)) :: Tsgs2 ! Sub-grid temperature variance [degC2] - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics - real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v logical :: present_slope_x, present_slope_y, calc_derivatives integer, dimension(2) :: EOSdom_u ! The shifted i-computational domain to use for equation of @@ -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) @@ -780,7 +780,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Variance should be positive but round-off can violate this. Calculating ! variance directly would fix this but requires more operations. Tsgs2(i,j,k) = CS%Stanley_det_coeff * max(0., mn_T2) - enddo ; enddo ; enddo + enddo ; enddo ; enddo endif !$OMP do do j=js-1,je+1 @@ -1465,38 +1465,38 @@ end subroutine streamfn_solver !> Modifies thickness diffusivities to untangle layer structures subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & int_slope_u, int_slope_v) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [L2 T-1 ~> m2 s-1] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity - !! at v points [L2 T-1 ~> m2 s-1] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment [T ~> s] - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from - !! the interface slopes without consideration - !! of density gradients. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from - !! the interface slopes without consideration - !! of density gradients. + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface positions [Z ~> m] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces + !! at u points [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces + !! at v points [L2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity + !! at u points [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity + !! at v points [L2 T-1 ~> m2 s-1] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + real, intent(in) :: dt !< Time increment [T ~> s] + type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & de_top ! The distances between the top of a layer and the top of the ! region where the detangling is applied [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at ! u points [L2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & Kh_lay_v ! The tentative interface height diffusivity for each layer at ! v points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1535,11 +1535,11 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real :: Kh_max ! A local ceiling on the diffusivity [L2 T-1 ~> m2 s-1]. real :: wt1, wt2 ! Nondimensional weights. ! Variables used only in testing code. - ! real, dimension(SZK_(G)) :: uh_here - ! real, dimension(SZK_(G)+1) :: Sfn + ! real, dimension(SZK_(GV)) :: uh_here + ! real, dimension(SZK_(GV)+1) :: Sfn real :: dKh ! An increment in the diffusivity [L2 T-1 ~> m2 s-1]. - real, dimension(SZIB_(G),SZK_(G)+1) :: & + real, dimension(SZIB_(G),SZK_(GV)+1) :: & Kh_bg, & ! The background (floor) value of Kh [L2 T-1 ~> m2 s-1]. Kh, & ! The tentative value of Kh [L2 T-1 ~> m2 s-1]. Kh_detangle, & ! The detangling diffusivity that could be used [L2 T-1 ~> m2 s-1]. @@ -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', & @@ -2066,10 +2066,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) @@ -2086,22 +2086,22 @@ 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME !< interface height + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: KH_u_GME !< interface height !! 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 + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: KH_v_GME !< interface height !! diffusivities at v-faces [L2 T-1 ~> m2 s-1] ! 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..64eb80acb5 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 @@ -299,7 +299,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ ! v points CS%num_col_v = 0 ; !CS%fldno_v = 0 - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) CS%num_col_v = CS%num_col_v + 1 enddo ; enddo @@ -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 @@ -486,7 +486,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)) ; Iresttime_v(:,:) = 0.0 ! u points CS%num_col_u = 0 ; !CS%fldno_u = 0 - do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB + do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & CS%num_col_u = CS%num_col_u + 1 @@ -512,7 +512,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) "The total number of columns where sponges are applied at u points.", like_default=.true.) ! v points CS%num_col_v = 0 ; !CS%fldno_v = 0 - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & CS%num_col_v = CS%num_col_v + 1 @@ -556,13 +556,15 @@ end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable !! whose address is given by f_ptr. -subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure (in/out). +subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS) + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure (in/out). real, dimension(SZI_(G),SZJ_(G),CS%nz_data), & - intent(in) :: sp_val !< Field to be used in the sponge, it has arbitrary number of layers. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - target, intent(in) :: f_ptr !< Pointer to the field to be damped + intent(in) :: sp_val !< Field to be used in the sponge, it can have an + !! arbitrary number of layers. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -658,15 +660,16 @@ end subroutine set_up_ALE_sponge_field_varying !> This subroutine stores the reference profile at u and v points for the variable !! whose address is given by u_ptr and v_ptr. -subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). +subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, CS) + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), & - intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers. + intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers. real, dimension(SZI_(G),SZJB_(G),CS%nz_data), & - intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped + intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), target, intent(in) :: u_ptr !< u pointer to the field to be damped + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), target, intent(in) :: v_ptr !< v pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -696,17 +699,18 @@ end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at uand v points for the variable !! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, & - Time, G, US, CS, u_ptr, v_ptr) + Time, G, GV, US, CS, u_ptr, v_ptr) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file character(len=*), intent(in) :: filename_v !< File name for v field character(len=*), intent(in) :: fieldname_v !< Name of v variable in file type(time_type), intent(in) :: Time !< Model time type(ocean_grid_type), intent(inout) :: G !< Ocean grid (in) + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in). + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in). + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in). ! Local variables real, allocatable, dimension(:,:,:) :: u_val !< U field to be used in the sponge. real, allocatable, dimension(:,:,:) :: mask_u !< U field mask for the sponge data. @@ -795,8 +799,8 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim]. real :: m_to_Z ! A unit conversion factor from m to Z. real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid - real, dimension(SZK_(G)) :: tmp_val1 ! data values remapped to model grid - real, dimension(SZK_(G)) :: h_col ! A column of thicknesses at h, u or v points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid + real, dimension(SZK_(GV)) :: h_col ! A column of thicknesses at h, u or v points [H ~> m or kg m-2] real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts real, dimension(:), allocatable :: hsrc ! Source thicknesses [Z ~> m]. @@ -810,7 +814,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 +990,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 +1046,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) @@ -1079,7 +1084,7 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, turns, param_file) call rotate_array(sp_val_in, turns, sp_val) ! NOTE: This points sp_val with the unrotated field. See note below. - call set_up_ALE_sponge_field(sp_val, G, sp_ptr, sponge) + call set_up_ALE_sponge_field(sp_val, G, GV, sp_ptr, sponge) deallocate(sp_val_in) else diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index ae650664b6..0dfa29931d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -548,7 +548,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_La_SL = register_diag_field('ocean_model', 'KPP_La_SL', diag%axesT1, Time, & 'Surface-layer Langmuir number computed in [CVMix] KPP','nondim') - allocate( CS%N( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + allocate( CS%N( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) CS%N(:,:,:) = 0. allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) CS%OBLdepth(:,:) = 0. @@ -556,28 +556,28 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%kOBL(:,:) = 0. allocate( CS%La_SL( SZI_(G), SZJ_(G) ) ) CS%La_SL(:,:) = 0. - allocate( CS%Vt2( SZI_(G), SZJ_(G), SZK_(G) ) ) + allocate( CS%Vt2( SZI_(G), SZJ_(G),SZK_(GV) ) ) CS%Vt2(:,:,:) = 0. if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) ) ; CS%OBLdepthprev(:,:) = 0.0 - if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G),SZK_(GV) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. - if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) + if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G),SZK_(GV) ) ) if (CS%id_BulkUz2 > 0) CS%Uz2(:,:,:) = 0. - if (CS%id_BulkRi > 0) allocate( CS%BulkRi( SZI_(G), SZJ_(G), SZK_(G) ) ) + if (CS%id_BulkRi > 0) allocate( CS%BulkRi( SZI_(G), SZJ_(G),SZK_(GV) ) ) if (CS%id_BulkRi > 0) CS%BulkRi(:,:,:) = 0. - if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) if (CS%id_Sigma > 0) CS%sigma(:,:,:) = 0. - if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G), SZK_(G) ) ) + if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G),SZK_(GV) ) ) if (CS%id_Ws > 0) CS%Ws(:,:,:) = 0. - if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) if (CS%id_N2 > 0) CS%N2(:,:,:) = 0. - if (CS%id_Kt_KPP > 0) allocate( CS%Kt_KPP( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + if (CS%id_Kt_KPP > 0) allocate( CS%Kt_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) if (CS%id_Kt_KPP > 0) CS%Kt_KPP(:,:,:) = 0. - if (CS%id_Ks_KPP > 0) allocate( CS%Ks_KPP( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + if (CS%id_Ks_KPP > 0) allocate( CS%Ks_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) if (CS%id_Ks_KPP > 0) CS%Ks_KPP(:,:,:) = 0. - if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) if (CS%id_Kv_KPP > 0) CS%Kv_KPP(:,:,:) = 0. if (CS%id_Tsurf > 0) allocate( CS%Tsurf( SZI_(G), SZJ_(G)) ) if (CS%id_Tsurf > 0) CS%Tsurf(:,:) = 0. @@ -587,9 +587,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) if (CS%id_Usurf > 0) CS%Usurf(:,:) = 0. if (CS%id_Vsurf > 0) allocate( CS%Vsurf( SZI_(G), SZJB_(G)) ) if (CS%id_Vsurf > 0) CS%Vsurf(:,:) = 0. - if (CS%id_EnhVt2 > 0) allocate( CS%EnhVt2( SZI_(G), SZJ_(G), SZK_(G)) ) + if (CS%id_EnhVt2 > 0) allocate( CS%EnhVt2( SZI_(G), SZJ_(G),SZK_(GV)) ) if (CS%id_EnhVt2 > 0) CS%EnhVt2(:,:,:) = 0. - if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) if (CS%id_EnhK > 0) CS%EnhK(:,:,:) = 0. id_clock_KPP_calc = cpu_clock_id('Ocean KPP calculate)', grain=CLOCK_MODULE) @@ -603,33 +603,33 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & nonLocalTransScalar, waves) ! Arguments - type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP !! (out) Vertical diffusivity including KPP !! [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP !! (out) Vertical diffusivity including KPP !! [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP !! [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [m s-1] + type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! 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) @@ -907,32 +907,32 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity [ppt] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< potential/cons temp [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< Salinity [ppt] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Velocity j-component [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! 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) ) @@ -1286,13 +1286,13 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) type(KPP_CS), pointer :: CS !< Control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration - 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 @@ -1391,21 +1391,21 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & type(KPP_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] real, intent(in) :: dt !< Time-step [s] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: scalar !< temperature + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature real, intent(in) :: C_p !< Seawater specific heat capacity [J kg-1 degC-1] integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G), SZK_(G) ) :: dtracer + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer 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) ) / & @@ -1416,8 +1416,8 @@ 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 + !$OMP parallel do default(none) shared(dt, scalar, dtracer, G, GV) + 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)) * & @@ -1453,20 +1453,20 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, type(KPP_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] real, intent(in) :: dt !< Time-step [s] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: scalar !< Scalar (scalar units [conc]) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G), SZK_(G) ) :: dtracer + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer 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) ) / & @@ -1477,8 +1477,8 @@ 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 + !$OMP parallel do default(none) shared(G, GV, dt, scalar, dtracer) + 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_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 7c5547c911..89c0bf8377 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -90,7 +90,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) ! Warn user if EPBL is being used, since in this case mixing due to convection will ! be aplied in the boundary layer if (useEPBL) then - call MOM_error(WARNING, 'MOM_CVMix_conv_init: '// & + call MOM_error(WARNING, 'MOM_CVMix_conv_init: '// & 'CVMix convection may not be properly applied when ENERGETICS_SFC_PBL = True'//& 'as convective mixing might occur in the boundary layer.') endif @@ -149,13 +149,13 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) type(CVMix_conv_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_conv_init. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl !< Depth of ocean boundary layer [Z ~> m] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd !< Diapycnal diffusivity at each interface that !! will be incremented here [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: KV !< Viscosity at each interface that will be !! incremented here [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_aux !< A second diapycnal diffusivity at each !! interface that will also be incremented !! here [Z2 T-1 ~> m2 s-1]. 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..85d9c63a39 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -60,14 +60,14 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_H !< Initial zonal velocity on T points [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: v_H !< Initial meridional velocity on T !! points [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]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous !! call to CVMix_shear_init. @@ -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 @@ -231,22 +231,22 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) "If true, use the Large-McWilliams-Doney (JGR 1994) "//& "shear mixing parameterization.", default=.false.) if (CS%use_LMD94) then - NumberTrue=NumberTrue + 1 - CS%Mix_Scheme='KPP' + NumberTrue=NumberTrue + 1 + CS%Mix_Scheme='KPP' endif call get_param(param_file, mdl, "USE_PP81", CS%use_PP81, & "If true, use the Pacanowski and Philander (JPO 1981) "//& "shear mixing parameterization.", default=.false.) if (CS%use_PP81) then - NumberTrue = NumberTrue + 1 - CS%Mix_Scheme='PP' + NumberTrue = NumberTrue + 1 + CS%Mix_Scheme='PP' endif use_JHL=kappa_shear_is_used(param_file) if (use_JHL) NumberTrue = NumberTrue + 1 ! After testing for interior schemes, make sure only 0 or 1 are enabled. ! Otherwise, warn user and kill job. if ((NumberTrue) > 1) then - call MOM_error(FATAL, 'MOM_CVMix_shear_init: '// & + call MOM_error(FATAL, 'MOM_CVMix_shear_init: '// & 'Multiple shear driven internal mixing schemes selected,'//& ' please disable all but one scheme to proceed.') endif @@ -281,26 +281,26 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2', conversion=US%s_to_T**2) if (CS%id_N2 > 0) then - allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%N2(:,:,:) = 0. + allocate( CS%N2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) ; CS%N2(:,:,:) = 0. endif CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & 'Square of vertical shear used by MOM_CVMix_shear module','1/s2', conversion=US%s_to_T**2) if (CS%id_S2 > 0) then - allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%S2(:,:,:) = 0. + allocate( CS%S2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) ; CS%S2(:,:,:) = 0. endif CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & 'Gradient Richarson number used by MOM_CVMix_shear module','nondim') if (CS%id_ri_grad > 0) then !Initialize w/ large Richardson value - allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad(:,:,:) = 1.e8 + allocate( CS%ri_grad( SZI_(G), SZJ_(G),SZK_(GV)+1 )) ; CS%ri_grad(:,:,:) = 1.e8 endif CS%id_ri_grad_smooth = register_diag_field('ocean_model', 'ri_grad_shear_smooth', & diag%axesTi, Time, & 'Smoothed gradient Richarson number used by MOM_CVMix_shear module','nondim') if (CS%id_ri_grad_smooth > 0) then !Initialize w/ large Richardson value - allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8 + allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G),SZK_(GV)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8 endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & 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_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 3bea0d9937..4a9d428807 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -2641,12 +2641,12 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, dT_dS_gauge*dRcv_dT(i)*(S(i,k1)-S(i,kb2)) if (dSpice_det*dSpice_lim <= 0.0) dSpice_lim = 0.0 endif - if (k1 10.0*Angstrom) then + if (k1 10.0*Angstrom) then dSpice_lim2 = dS_dT_gauge*dRcv_dS(i)*(T(i,k1+1)-T(i,kb2)) - & dT_dS_gauge*dRcv_dT(i)*(S(i,k1+1)-S(i,kb2)) if ((dSpice_det*dSpice_lim2 > 0.0) .and. & (abs(dSpice_lim2) > abs(dSpice_lim))) dSpice_lim = dSpice_lim2 - endif; endif + endif ; endif if (abs(dSpice_det) > abs(dSpice_lim)) dSpice_det = dSpice_lim I_denom = 1.0 / (dRcv_dS(i)**2 + (dT_dS_gauge*dRcv_dT(i))**2) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1683e21fbe..470098a08a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -103,7 +103,7 @@ module MOM_diabatic_aux subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any available !! thermodynamic fields. @@ -119,7 +119,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) fraz_col, & ! The accumulated heat requirement due to frazil [Q R Z ~> J m-2]. T_freeze, & ! The freezing potential temperature at the current salinity [degC]. ps ! Surface pressure [R L2 T-2 ~> Pa] - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & pressure ! The pressure at the middle of each layer [R L2 T-2 ~> Pa]. real :: H_to_RL2_T2 ! A conversion factor from thicknesses in H to pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] real :: hc ! A layer's heat capacity [Q R Z degC-1 ~> J m-2 degC-1]. @@ -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 @@ -226,17 +226,17 @@ end subroutine make_frazil subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: T !< Potential temperature [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: S !< Salinity [PSU] or [gSalt/kg], generically [ppt]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: Kd_T !< The extra diffusivity of temperature due to !! double diffusion relative to the diffusivity of !! diffusivity of density [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(in) :: Kd_S !< The extra diffusivity of salinity due to !! double diffusion relative to the diffusivity of !! diffusivity of density [Z2 T-1 ~> m2 s-1]. @@ -246,9 +246,9 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2]. d1_T, d1_S ! Variables used by the tridiagonal solvers [nondim]. - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & mix_T, mix_S ! Mixing distances in both directions across each interface [H ~> m or kg m-2]. real :: h_tr ! h_tr is h at tracer points with a tiny thickness ! added to ensure positive definiteness [H ~> m or kg m-2]. @@ -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) @@ -322,7 +322,7 @@ end subroutine differential_diffuse_T_S subroutine adjust_salt(h, tv, G, GV, CS, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. @@ -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 @@ -379,25 +379,25 @@ end subroutine adjust_salt !> This is a simple tri-diagonal solver for T and S. !! "Simple" means it only uses arrays hold, ea and eb. subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) - 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) :: is !< The start i-index to work on. - integer, intent(in) :: ie !< The end i-index to work on. - integer, intent(in) :: js !< The start j-index to work on. - integer, intent(in) :: je !< The end j-index to work on. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold !< The layer thicknesses before entrainment, - !! [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< The amount of fluid entrained from the layer - !! above within this time step [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< The amount of fluid entrained from the layer - !! below within this time step [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities [ppt]. + 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) :: is !< The start i-index to work on. + integer, intent(in) :: ie !< The end i-index to work on. + integer, intent(in) :: js !< The start j-index to work on. + integer, intent(in) :: je !< The end j-index to work on. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: hold !< The layer thicknesses before entrainment, + !! [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< The amount of fluid entrained from the layer + !! above within this time step [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< The amount of fluid entrained from the layer + !! below within this time step [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: T !< Layer potential temperatures [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. ! Local variables real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-2 or m2 kg-1]. real :: d1(SZIB_(G)) ! A variable used by the tridiagonal solver [nondim]. - real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. + real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: h_tr, b_denom_1 ! Two temporary thicknesses [H ~> m or kg m-2]. integer :: i, j, k @@ -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 @@ -429,23 +429,23 @@ end subroutine triDiagTS !> This is a simple tri-diagonal solver for T and S, with mixing across interfaces but no net !! transfer of mass. subroutine triDiagTS_Eulerian(G, GV, is, ie, js, je, hold, ent, T, S) - 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) :: is !< The start i-index to work on. - integer, intent(in) :: ie !< The end i-index to work on. - integer, intent(in) :: js !< The start j-index to work on. - integer, intent(in) :: je !< The end j-index to work on. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold !< The layer thicknesses before entrainment, - !! [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: ent !< The amount of fluid mixed across an interface - !! within this time step [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities [ppt]. + 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) :: is !< The start i-index to work on. + integer, intent(in) :: ie !< The end i-index to work on. + integer, intent(in) :: js !< The start j-index to work on. + integer, intent(in) :: je !< The end j-index to work on. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: hold !< The layer thicknesses before entrainment, + !! [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: ent !< The amount of fluid mixed across an interface + !! within this time step [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: T !< Layer potential temperatures [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. ! Local variables real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-2 or m2 kg-1]. real :: d1(SZIB_(G)) ! A variable used by the tridiagonal solver [nondim]. - real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. + real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: h_tr, b_denom_1 ! Two temporary thicknesses [H ~> m or kg m-2]. integer :: i, j, k @@ -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 @@ -481,21 +481,21 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) 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(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: u_h !< Zonal velocity interpolated to h points [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: v_h !< Meridional velocity interpolated to h points [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: ea !< The amount of fluid entrained from the layer !! above within this time step [H ~> m or kg m-2]. !! Omitting ea is the same as setting it to 0. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: eb !< The amount of fluid entrained from the layer !! below within this time step [H ~> m or kg m-2]. !! Omitting eb is the same as setting it to 0. @@ -507,7 +507,9 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: b1(SZI_(G)), d1(SZI_(G)), c1(SZI_(G),SZK_(G)) + real :: b1(SZI_(G)) ! A thickness used in the tridiagonal solver [H ~> m or kg m-2] + real :: c1(SZI_(G),SZK_(GV)) ! A variable used in the tridiagonal solver [nondim] + real :: d1(SZI_(G)) ! The complement of c1 [nondim] real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open ! ocean, nondimensional. @@ -637,7 +639,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & "The tracer flow control structure must be associated when the model sets "//& "the chlorophyll internally in set_pen_shortwave.") - call get_chl_from_model(chl_3d, G, tracer_flow_CSp) + call get_chl_from_model(chl_3d, G, GV, tracer_flow_CSp) if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) @@ -660,7 +662,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: id_MLD !< Handle (ID) of MLD diagnostic - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields. @@ -699,7 +701,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) @@ -812,7 +814,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(3), intent(in) :: Mixing_Energy !< Energy values for up to 3 MLDs - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields. @@ -820,7 +822,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) ! Local variables real, dimension(SZI_(G), SZJ_(G),3) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. - real, dimension(SZK_(G)) :: Z_L, Z_U, dZ, Rho_c, pRef_MLD + real, dimension(SZK_(GV)) :: Z_L, Z_U, dZ, Rho_c, pRef_MLD real, dimension(3) :: PE_threshold real :: ig, E_g @@ -835,7 +837,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 @@ -845,7 +847,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) PE_threshold(iM) = Mixing_Energy(iM)/GV%g_earth enddo - do j=js,je; do i=is,ie + do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0.0) then call calculate_density(tv%T(i,j,:), tv%S(i,j,:), pRef_MLD, rho_c, 1, nz, & @@ -1004,7 +1006,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t type(optics_type), pointer :: optics !< Optical properties container integer, intent(in) :: nsw !< The number of frequency bands of penetrating !! shortwave radiation - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. @@ -1013,13 +1015,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !! can be evaporated in one time-step [nondim]. real, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! heat and freshwater fluxes is applied [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: cTKE !< Turbulent kinetic energy requirement to mix !! forcing through each layer [R Z3 T-2 ~> J m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with !! potential temperature [R-1 degC-1 ~> m3 kg-1 degC-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity [R-1 ppt-1 ~> m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & @@ -1055,7 +1057,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] netMassInOut_rate! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G), SZK_(G)) :: & + real, dimension(SZI_(G), SZK_(GV)) :: & h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] T2d, & ! A 2-d copy of the layer temperatures [degC] pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within @@ -1069,7 +1071,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! [degC H ~> degC m or degC kg m-2] Pen_SW_bnd_rate ! The penetrative shortwave heating rate by band ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - real, dimension(max(nsw,1),SZI_(G),SZK_(G)) :: & + real, dimension(max(nsw,1),SZI_(G),SZK_(GV)) :: & opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency ! band of shortwave radation in each layer [H-1 ~> m-1 or m2 kg-1] real, dimension(maxGroundings) :: hGrounding ! Thickness added by each grounding event [H ~> m or kg m-2] @@ -1084,7 +1086,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 @@ -1220,7 +1222,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h2d, T2d, netMassInOut, netMassOut, netHeat, netSalt, & Pen_SW_bnd, tv, aggregate_FW_forcing, nonpenSW=nonpenSW) - endif + endif ! ea is for passive tracers do i=is,ie ! ea(i,j,1) = netMassInOut(i) @@ -1569,7 +1571,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 @@ -1578,7 +1580,7 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori return else allocate(CS) - endif + endif CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a4ef2de227..649fc725de 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -3352,7 +3352,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..a558f9dd2b 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -52,7 +52,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have NULL @@ -62,20 +62,20 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real, intent(in) :: dt !< The time increment [T ~> s]. type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: ea !< The amount of fluid entrained from the layer !! above within this time step [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: eb !< The amount of fluid entrained from the layer !! below within this time step [H ~> m or kg m-2]. integer, dimension(SZI_(G),SZJ_(G)), & optional, intent(inout) :: kb_out !< The index of the lightest layer denser than !! the buffer layer. ! At least one of the two following arguments must be present. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers !! [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces !! [Z2 T-1 ~> m2 s-1]. @@ -85,11 +85,11 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! differences between layers. The scheme that is used here is described in ! detail in Hallberg, Mon. Wea. Rev. 2000. - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & dtKd ! The layer diapycnal diffusivity times the time step [H2 ~> m2 or kg2 m-4]. - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & dtKd_int ! The diapycnal diffusivity at the interfaces times the time step [H2 ~> m2 or kg2 m-4] - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & F, & ! The density flux through a layer within a time step divided by the ! density difference across the interface below the layer [H ~> m or kg m-2]. maxF, & ! maxF is the maximum value of F that will not deplete all of the @@ -102,7 +102,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & h_guess ! An estimate of the layer thicknesses after entrainment, but ! before the entrainments are adjusted to drive the layer ! densities toward their target values [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & Ent_bl ! The average entrainment upward and downward across ! each interface around the buffer layers [H ~> m or kg m-2]. real, allocatable, dimension(:,:,:) :: & @@ -114,8 +114,8 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real :: hm, fm, fr, fk ! Work variables with units of H, H, H, and H2. - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. + real :: b1(SZI_(G)) ! A variable used by the tridiagonal solver [H ~> m or kg m-2] + real :: c1(SZI_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim] real, dimension(SZI_(G)) :: & htot, & ! The total thickness above or below a layer [H ~> m or kg m-2]. @@ -148,7 +148,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & maxF_kb, & ! The maximum value of F_kb that might be realized [H ~> m or kg m-2]. eakb_maxF, & ! The value of eakb that gives F_kb=maxF_kb [H ~> m or kg m-2]. F_kb_maxEnt ! The value of F_kb when eakb = max_eakb [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & Sref, & ! The reference potential density of the mixed and buffer layers, ! and of the two lightest interior layers (kb and kb+1) copied ! into layers kmb+1 and kmb+2 [R ~> kg m-3]. @@ -156,7 +156,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! lightest interior layers (kb and kb+1) copied into layers kmb+1 ! and kmb+2 [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & ds_dsp1, & ! The coordinate variable (sigma-2) difference across an ! interface divided by the difference across the interface ! below it. [nondim] @@ -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 @@ -894,30 +894,30 @@ end subroutine entrainment_diffusive subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, do_i_in) 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),SZK_(G)), intent(in) :: F !< The density flux through a layer within + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: F !< The density flux through a layer within !! a time step divided by the density !! difference across the interface below !! the layer [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, dimension(SZI_(G)), intent(in) :: kb !< The index of the lightest layer denser than !! the deepest buffer layer. integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: j !< The meridional index upon which to work. type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: dsp1_ds !< The ratio of coordinate variable + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dsp1_ds !< The ratio of coordinate variable !! differences across the interfaces below !! a layer over the difference across the !! interface above the layer. real, dimension(SZI_(G)), intent(in) :: eakb !< The entrainment from above by the layer !! below the buffer layer [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid entrained from the layer !! above within this time step [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< The amount of fluid entrained from the layer !! below within this time step [H ~> m or kg m-2]. logical, dimension(SZI_(G)), & @@ -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 @@ -1024,9 +1024,9 @@ end subroutine F_to_ent subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, Sref, h_bl) 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(in) :: dtKd_int !< The diapycnal diffusivity across !! each interface times the time step !! [H2 ~> m2 or kg2 m-4]. @@ -1042,13 +1042,13 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< The meridional index upon which to work. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)), intent(out) :: Sref !< The coordinate potential density minus + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: Sref !< The coordinate potential density minus !! 1000 for each layer [R ~> kg m-3]. - real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: h_bl !< The thickness of each layer [H ~> m or kg m-2]. ! This subroutine sets the average entrainment across each of the interfaces ! between buffer layers within a timestep. It also causes thin and relatively @@ -1064,7 +1064,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, pres, & ! Reference pressure (P_Ref) [R L2 T-2 ~> Pa]. frac_rem, & ! The fraction of the diffusion remaining [nondim]. h_interior ! The interior thickness available for entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G), SZK_(G)) :: & + real, dimension(SZI_(G), SZK_(GV)) :: & S_est ! An estimate of the coordinate potential density - 1000 after ! entrainment for each layer [R ~> kg m-3]. real :: max_ent ! The maximum possible entrainment [H ~> m or kg m-2]. @@ -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 @@ -1201,9 +1201,9 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & 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),SZK_(G)), intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< Reference potential density [R ~> kg m-3] - real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: Sref !< Reference potential density [R ~> kg m-3] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface !! around the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: E_kb !< The entrainment by the top interior @@ -1248,7 +1248,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! also be returned. ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & b1, c1, & ! b1 and c1 are variables used by the tridiagonal solver. S, dS_dE, & ! The coordinate density [R ~> kg m-3] and its derivative with E. ea, dea_dE, & ! The entrainment from above and its derivative with E. @@ -1440,14 +1440,14 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & G, GV, CS, ea_kb, tol_in) 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),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: h_bl !< Layer thickness, with the top interior !! layer at k-index kmb+1 [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Sref !< The coordinate reference potential density, !! with the value of the topmost interior layer !! at index kmb+1 [R ~> kg m-3]. - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Ent_bl !< The average entrainment upward and downward !! across each interface around the buffer layers, !! [H ~> m or kg m-2]. @@ -1573,13 +1573,13 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & error, err_min_eakb0, err_max_eakb0, F_kb, dFdfm_kb) 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),SZK_(G)), intent(in) :: h_bl !< Layer thickness, with the top interior + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h_bl !< Layer thickness, with the top interior !! layer at k-index kmb+1 [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< The coordinate reference potential + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: Sref !< The coordinate reference potential !! density, with the value of the !! topmost interior layer at layer !! kmb+1 [R ~> kg m-3]. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in @@ -1785,11 +1785,11 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & F_lim_maxent, F_thresh) 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),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Sref !< Reference potential density [R ~> kg m-3]. - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 3be6628b14..ceb77b52b8 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -23,13 +23,13 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: T_adj !< Adjusted potential temperature [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: S_adj !< Adjusted salinity [ppt]. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL). real, intent(in) :: Kddt_smooth !< A smoothing vertical @@ -39,7 +39,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & dRho_dT, & ! The derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] dRho_dS ! The derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. real :: h_neglect, h0 ! A thickness that is so small it is usually lost @@ -54,7 +54,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, ! mixing with layers above rescaled by a factor of d_a [ppt]. ! This array is discreted on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & Te_b, & ! A partially updated temperature estimate including the influnce from ! mixing with layers below rescaled by a factor of d_b [degC]. ! This array is discreted on tracer cells, but contains an extra @@ -63,7 +63,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, ! mixing with layers below rescaled by a factor of d_b [ppt]. ! This array is discreted on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & c_a, & ! The fractional influence of the properties of the layer below ! in the final properies with a downward-first solver, nondim. d_a, & ! The fractional influence of the properties of the layer in question @@ -74,7 +74,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, d_b ! The fractional influence of the properties of the layer in question ! and layers below in the final properies with a upward-first solver, nondim. ! d_b = 1.0 - c_b - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & mix !< The amount of mixing across the interface between layers [H ~> m or kg m-2]. real :: mix_len ! The length-scale of mixing, when it is active [H ~> m or kg m-2] real :: h_b, h_a ! The thicknessses of the layers above and below an interface [H ~> m or kg m-2] @@ -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 @@ -322,15 +322,15 @@ end function is_unstable subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: Kddt !< A diffusivity times a time increment [H2 ~> m2 or kg2 m-4]. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: dR_dT !< Derivative of locally referenced !! potential density with temperature [R degC-1 ~> kg m-3 degC-1] - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: dR_dS !< Derivative of locally referenced !! potential density with salinity [R degC-1 ~> kg m-3 ppt-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -339,12 +339,12 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables - real :: mix(SZI_(G),SZK_(G)+1) ! The diffusive mixing length (kappa*dt)/dz + real :: mix(SZI_(G),SZK_(GV)+1) ! The diffusive mixing length (kappa*dt)/dz ! between layers within in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: T_f(SZI_(G),SZK_(G)) ! Filtered temperatures [degC] - real :: S_f(SZI_(G),SZK_(G)) ! Filtered salinities [ppt] + real :: c1(SZI_(G),SZK_(GV)) ! tridiagonal solver. + real :: T_f(SZI_(G),SZK_(GV)) ! Filtered temperatures [degC] + real :: S_f(SZI_(G),SZK_(GV)) ! Filtered salinities [ppt] real :: pres(SZI_(G)) ! Interface pressures [R L2 T-2 ~> Pa]. real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures [degC] real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities [ppt] @@ -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 dadb5ac526..be390ef50f 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -51,27 +51,25 @@ module MOM_geothermal !! or very small, the layers are simply heated in place. Any heat that can not !! be applied to the ocean is returned (WHERE)? subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) - type(ocean_grid_type), intent(inout) :: 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) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers - !! to any available thermodynamic - !! fields. Absent fields have NULL - !! ptrs. - real, intent(in) :: dt !< Time increment [T ~> s]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< The amount of fluid moved - !! downward into a layer; this - !! should be increased due to mixed - !! layer detrainment [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: eb !< The amount of fluid moved upward - !! into a layer; this should be - !! increased due to mixed layer - !! entrainment [H ~> m or kg m-2]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(geothermal_CS), pointer :: CS !< The control structure returned by - !! a previous call to - !! geothermal_init. - integer, optional, intent(in) :: halo !< Halo width over which to work + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers + !! to any available thermodynamic fields. + real, intent(in) :: dt !< Time increment [T ~> s]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: ea !< The amount of fluid moved + !! downward into a layer; this + !! should be increased due to mixed + !! layer detrainment [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: eb !< The amount of fluid moved upward + !! into a layer; this should be + !! increased due to mixed layer + !! entrainment [H ~> m or kg m-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(geothermal_CS), pointer :: CS !< The control structure returned by + !! a previous call to + !! geothermal_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat [H degC ~> m degC or kg degC m-2] @@ -106,15 +104,10 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H Q-1 R-1 Z-1 ~> degC m3 J-1 or degC kg J-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_old ! Temperature of each layer - ! before any heat is added, - ! for diagnostics [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer - ! before any heat is added, - ! for diagnostics [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to - ! calculate change in heat - ! due to geothermal + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + T_old, & ! Temperature of each layer before any heat is added, for diagnostics [degC] + h_old, & ! Thickness of each layer before any heat is added, for diagnostics [H ~> m or kg m-2] + work_3d ! Scratch variable used to calculate changes due to geothermal real :: Idt ! inverse of the timestep [T-1 ~> s-1] logical :: do_i(SZI_(G)) @@ -122,7 +115,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 @@ -347,7 +340,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) if (CS%id_internal_heat_temp_tendency > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) - enddo; enddo; enddo + enddo ; enddo ; enddo call post_data(CS%id_internal_heat_temp_tendency, work_3d, CS%diag, alt_h=h_old) endif if (CS%id_internal_heat_h_tendency > 0) then @@ -368,18 +361,16 @@ end subroutine geothermal_entraining !! the bottom, by simply heating the water in place. Any heat that can not be applied to the ocean !! is returned (WHERE)? subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) - type(ocean_grid_type), intent(inout) :: 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(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers - !! to any available thermodynamic - !! fields. Absent fields have NULL - !! ptrs. - real, intent(in) :: dt !< Time increment [T ~> s]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(geothermal_CS), pointer :: CS !< The control structure returned by - !! a previous call to geothermal_init. - integer, optional, intent(in) :: halo !< Halo width over which to work + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers + !! to any available thermodynamic fields. + real, intent(in) :: dt !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(geothermal_CS), pointer :: CS !< The control structure returned by + !! a previous call to geothermal_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables real, dimension(SZI_(G)) :: & @@ -392,7 +383,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H Q-1 R-1 Z-1 ~> degC m3 J-1 or degC kg J-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & dTdt_diag ! Diagnostic of temperature tendency [degC T-1 ~> degC s-1] which might be ! converted into a layer-integrated heat tendency [Q R Z T-1 ~> W m-2] real :: Idt ! inverse of the timestep [T-1 ~> s-1] @@ -400,7 +391,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 79c69be095..7aca829db6 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -73,24 +73,24 @@ module MOM_int_tide_input !> Sets the model-state dependent internal tide energy sources. subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the - !! thermodynamic fields - type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes - type(int_tide_input_type), intent(inout) :: itide !< A structure containing fields related - !! to the internal tide sources. - real, intent(in) :: dt !< The time increment [T ~> s]. - type(int_tide_input_CS), pointer :: CS !< This module's 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the + !! thermodynamic fields + type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes + type(int_tide_input_type), intent(inout) :: itide !< A structure containing fields related + !! to the internal tide sources. + real, intent(in) :: dt !< The time increment [T ~> s]. + type(int_tide_input_CS), pointer :: CS !< This module's control structure. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & N2_bot ! The bottom squared buoyancy frequency [T-2 ~> s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & T_f, S_f ! The temperature and salinity in [degC] and [ppt] with the values in ! the massless layers filled vertically by diffusion. logical :: use_EOS ! If true, density is calculated from T & S using an @@ -100,7 +100,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: "//& @@ -154,23 +154,23 @@ end subroutine set_int_tide_input !> Estimates the near-bottom buoyancy frequency (N^2). subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) - 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] - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the - !! thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f !< Temperature after vertical filtering to - !! smooth out the values in thin layers [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to - !! smooth out the values in thin layers [ppt]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness [Z2 ~> m2]. - type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes - type(int_tide_input_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the + !! thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T_f !< Temperature after vertical filtering to + !! smooth out the values in thin layers [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S_f !< Salinity after vertical filtering to + !! smooth out the values in thin layers [ppt]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness [Z2 ~> m2]. + type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes + type(int_tide_input_CS), pointer :: CS !< This module's control structure. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the !! ocean bottom [T-2 ~> s-2]. ! Local variables - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & dRho_int ! The unfiltered density differences across interfaces [R ~> kg m-3]. real, dimension(SZI_(G)) :: & pres, & ! The pressure at each interface [R L2 T-2 ~> Pa]. @@ -190,7 +190,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..c553c41fc6 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -281,7 +281,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir chl_data(:,:) = 0.0 if (present(chl_3d)) then do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,1) ; enddo ; enddo - do k=1,nz; do j=js,je ; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (chl_3d(i,j,k) < 0.0)) then write(mesg,'(" Negative chl_3d of ",(1pe12.4)," found at i,j,k = ", & & 3(1x,i3), " lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & @@ -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..f67fb48fc7 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -71,17 +71,17 @@ module MOM_regularize_layers subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. real, intent(in) :: dt !< Time increment [T ~> s]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed !! layer detrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. @@ -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.") @@ -108,17 +108,17 @@ end subroutine regularize_layers subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. real, intent(in) :: dt !< Time increment [T ~> s]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed !! layer detrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. @@ -132,12 +132,12 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) def_rat_v ! The ratio of the thickness deficit to the minimum depth [nondim]. real, dimension(SZI_(G),SZJ_(G)) :: & def_rat_h ! The ratio of the thickness deficit to the minimum depth [nondim]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & e ! The interface depths [H ~> m or kg m-2], positive upward. - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & e_filt, e_2d ! The interface depths [H ~> m or kg m-2], positive upward. - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & h_2d, & ! A 2-d version of h [H ~> m or kg m-2]. T_2d, & ! A 2-d version of tv%T [degC]. S_2d, & ! A 2-d version of tv%S [ppt]. @@ -160,7 +160,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) h_tot1, Th_tot1, Sh_tot1, & h_tot3, Th_tot3, Sh_tot3, & h_tot2, Th_tot2, Sh_tot2 - real, dimension(SZK_(G)) :: & + real, dimension(SZK_(GV)) :: & h_prev_1d ! The previous thicknesses [H ~> m or kg m-2]. real :: I_dtol ! The inverse of the tolerance changes [nondim]. real :: I_dtol34 ! The inverse of the tolerance changes [nondim]. @@ -170,7 +170,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) real :: scale ! A scaling factor [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real, dimension(SZK_(G)+1) :: & + real, dimension(SZK_(GV)+1) :: & int_flux, int_Tflux, int_Sflux, int_Rflux real :: h_add real :: h_det_tot @@ -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.") @@ -616,7 +616,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & def_rat_u_2lay, def_rat_v_2lay, halo, h) 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)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(in) :: e !< Interface depths [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G)), & intent(out) :: def_rat_u !< The thickness deficit ratio at u points, @@ -635,7 +635,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & !! pointswhen the mixed and buffer layers !! are aggregated into 1 layer [nondim]. integer, optional, intent(in) :: halo !< An extra-wide halo size, 0 by default. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. !! If h is not present, vertical differences !! in interface heights are used instead. @@ -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..99dee11b9a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -213,15 +213,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & 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(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_h !< Zonal velocity interpolated to h points [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_h !< Meridional velocity interpolated to h points [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. @@ -232,15 +232,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !! boundary layer properies, and related fields. real, intent(in) :: dt !< Time increment [T ~> s]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(out) :: Kd_extra_T !< The extra diffusivity at interfaces of !! temperature due to double diffusion relative to !! the diffusivity of density [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(out) :: Kd_extra_S !< The extra diffusivity at interfaces of !! salinity due to double diffusion relative to !! the diffusivity of density [Z2 T-1 ~> m2 s-1]. @@ -251,11 +251,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & type(diffusivity_diags) :: dd ! structure with arrays of available diags - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & T_f, S_f ! Temperature and salinity [degC] and [ppt] with properties in massless layers ! filled vertically by diffusion or the properties after full convective adjustment. - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & N2_lay, & !< Squared buoyancy frequency associated with layers [T-2 ~> s-2] Kd_lay_2d, & !< The layer diffusivities [Z2 T-1 ~> m2 s-1] maxTKE, & !< Energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] @@ -263,7 +263,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !< TKE dissipated within a layer and Kd in that layer !< [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] Kd_int_2d, & !< The interface diffusivities [Z2 T-1 ~> m2 s-1] Kv_bkgnd, & !< The background diffusion related interface viscosities [Z2 T-1 ~> m2 s-1] @@ -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") @@ -304,8 +304,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if ((CS%use_CVMix_ddiff .or. CS%double_diffusion) .and. & .not.(present(Kd_extra_T) .and. present(Kd_extra_S))) & - call MOM_error(FATAL, "set_diffusivity: both Kd_extra_T and Kd_extra_S must be present "//& - "when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") + call MOM_error(FATAL, "set_diffusivity: both Kd_extra_T and Kd_extra_S must be present "//& + "when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") TKE_to_Kd_used = (CS%use_tidal_mixing .or. CS%ML_radiation .or. & (CS%bottomdraglaw .and. .not.CS%use_LOTW_BBL_diffusivity)) @@ -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 @@ -704,28 +704,28 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. - real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density + real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: dRho_int !< Change in locally referenced potential density !! across each interface [R ~> kg m-3]. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. integer, intent(in) :: j !< j-index of row to work on real, intent(in) :: dt !< Time increment [T ~> s]. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd !< The conversion rate between the + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: TKE_to_Kd !< The conversion rate between the !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & ds_dsp1, & ! coordinate variable (sigma-2) difference across an ! interface divided by the difference across the interface ! below it [nondim] @@ -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 @@ -918,29 +918,29 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: T_f !< layer temperature with the values in massless layers !! filled vertically by diffusion [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: S_f !< Layer salinities with values in massless !! layers filled vertically by diffusion [ppt]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes integer, intent(in) :: j !< j-index of row to work on type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: dRho_int !< Change in locally referenced potential density !! across each interface [R ~> kg m-3]. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces [T-2 ~> s-2]. - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(out) :: N2_lay !< The squared buoyancy frequency of the layers [T-2 ~> s-2]. real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency [T-2 ~> s-2]. ! Local variables - real, dimension(SZI_(G),SZK_(G)+1) :: & + real, dimension(SZI_(G),SZK_(GV)+1) :: & dRho_int_unfilt, & ! unfiltered density differences across interfaces [R ~> kg m-3] dRho_dT, & ! partial derivative of density wrt temp [R degC-1 ~> kg m-3 degC-1] dRho_dS ! partial derivative of density wrt saln [R ppt-1 ~> kg m-3 ppt-1] @@ -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 @@ -1091,20 +1091,20 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields; absent fields have NULL ptrs. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: T_f !< layer temperatures with the values in massless layers !! filled vertically by diffusion [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: S_f !< Layer salinities with values in massless !! layers filled vertically by diffusion [ppt]. integer, intent(in) :: j !< Meridional index upon which to work. type(set_diffusivity_CS), pointer :: CS !< Module control structure. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal !! diffusivity for temp [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal !! diffusivity for saln [Z2 T-1 ~> m2 s-1]. @@ -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 @@ -1177,11 +1177,11 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & 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(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. @@ -1189,26 +1189,26 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields integer, intent(in) :: j !< j-index of row to work on - real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum-realizable thickness [Z3 T-3 ~> m3 s-3] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - real, dimension(SZI_(G),SZK_(G)), intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers, + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers, !! [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1]. ! This routine adds diffusion sustained by flow energy extracted by bottom drag. - real, dimension(SZK_(G)+1) :: & + real, dimension(SZK_(GV)+1) :: & Rint ! coordinate density of an interface [R ~> kg m-3] real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the @@ -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) @@ -1415,11 +1415,11 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< u component of flow [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< v component of flow [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. @@ -1427,13 +1427,13 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. integer, intent(in) :: j !< j-index of row to work on - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [T-2 ~> s-2] type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] ! Local variables @@ -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]. @@ -1575,19 +1575,19 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< Surface fluxes structure integer, intent(in) :: j !< The j-index to work on type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces !! [Z2 T-1 ~> m2 s-1]. @@ -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 @@ -1719,11 +1719,11 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom @@ -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.") @@ -1903,7 +1903,7 @@ end subroutine set_BBL_TKE subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields; absent @@ -1914,25 +1914,25 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) type(set_diffusivity_CS), pointer :: CS !< Control structure returned by previous !! call to diabatic_entrain_init. integer, intent(in) :: j !< Meridional index upon which to work. - real, dimension(SZI_(G),SZK_(G)), intent(out) :: ds_dsp1 !< Coordinate variable (sigma-2) + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: ds_dsp1 !< Coordinate variable (sigma-2) !! difference across an interface divided by !! the difference across the interface below !! it [nondim] - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & optional, intent(in) :: rho_0 !< Layer potential densities relative to !! surface press [R ~> kg m-3]. ! Local variables real :: g_R0 ! g_R0 is a rescaled version of g/Rho [L2 Z-1 R-1 T-2 ~> m4 kg-1 s-2] - real :: eps, tmp ! nondimensional temproray variables - real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables + real :: eps, tmp ! nondimensional temporary variables + real :: a(SZK_(GV)), a_0(SZK_(GV)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures [R L2 T-2 ~> Pa] - real :: Rcv(SZI_(G),SZK_(G)) ! coordinate density in the mixed and buffer layers [R ~> kg m-3] + real :: Rcv(SZI_(G),SZK_(GV)) ! coordinate density in the mixed and buffer layers [R ~> kg m-3] real :: I_Drho ! temporary variable [R-1 ~> m3 kg-1] 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..6ff8faf2f0 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -193,11 +193,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields @@ -235,7 +235,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) D_v, & ! Bottom depth interpolated to v points [Z ~> m]. mask_v ! A mask that disables any contributions from v points that ! are land or past open boundary conditions [nondim], 0 or 1. - real, dimension(SZIB_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZK_(GV)) :: & h_at_vel, & ! Layer thickness at a velocity point, using an upwind-biased ! second order accurate estimate based on the previous velocity ! direction [H ~> m or kg m-2]. @@ -314,7 +314,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! L, or the error for the interface below [H ~> m or kg m-2]. real :: Vol_quit ! The volume error below which to quit iterating [H ~> m or kg m-2]. real :: Vol_tol ! A volume error tolerance [H ~> m or kg m-2]. - real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at + real :: L(SZK_(GV)+1) ! The fraction of the full cell width that is open at ! the depth of each interface [nondim]. real :: L_direct ! The value of L above volume Vol_direct [nondim]. real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim]. @@ -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 @@ -603,7 +603,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) hwtot = hwtot + hweight if ((.not.CS%linear_drag) .and. (hweight >= 0.0)) then ; if (m==1) then - v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) + v_at_u = set_v_at_u(v, h, G, GV, i, j, k, mask_v, OBC) if (CS%BBL_use_tidal_bg) then U_bg_sq = 0.5*( G%mask2dT(i,j)*(CS%tideamp(i,j)*CS%tideamp(i,j))+ & G%mask2dT(i+1,j)*(CS%tideamp(i+1,j)*CS%tideamp(i+1,j)) ) @@ -611,7 +611,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) hutot = hutot + hweight * sqrt(u(I,j,k)*u(I,j,k) + & v_at_u*v_at_u + U_bg_sq) else - u_at_v = set_u_at_v(u, h, G, i, j, k, mask_u, OBC) + u_at_v = set_u_at_v(u, h, G, GV, i, j, k, mask_u, OBC) if (CS%BBL_use_tidal_bg) then U_bg_sq = 0.5*( G%mask2dT(i,j)*(CS%tideamp(i,j)*CS%tideamp(i,j))+ & G%mask2dT(i,j+1)*(CS%tideamp(i,j+1)*CS%tideamp(i,j+1)) ) @@ -1004,13 +1004,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then if (Rayleigh > 0.0) then - v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) + v_at_u = set_v_at_u(v, h, G, GV, i, j, k, mask_v, OBC) visc%Ray_u(I,j,k) = Rayleigh*sqrt(u(I,j,k)*u(I,j,k) + & v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then - u_at_v = set_u_at_v(u, h, G, i, j, k, mask_u, OBC) + u_at_v = set_u_at_v(u, h, G, GV, i, j, k, mask_u, OBC) visc%Ray_v(i,J,k) = Rayleigh*sqrt(v(i,J,k)*v(i,J,k) + & u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif @@ -1112,20 +1112,21 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) end subroutine set_viscous_BBL !> This subroutine finds a thickness-weighted value of v at the u-points. -function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - integer, intent(in) :: i !< The i-index of the u-location to work on. - integer, intent(in) :: j !< The j-index of the u-location to work on. - integer, intent(in) :: k !< The k-index of the u-location to work on. +function set_v_at_u(v, h, G, GV, i, j, k, mask2dCv, OBC) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + integer, intent(in) :: i !< The i-index of the u-location to work on. + integer, intent(in) :: j !< The j-index of the u-location to work on. + integer, intent(in) :: k !< The k-index of the u-location to work on. real, dimension(SZI_(G),SZJB_(G)),& - intent(in) :: mask2dCv !< A multiplicative mask of the v-points - type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_v_at_u !< The return value of v at u points points in the - !! same units as u, i.e. [L T-1 ~> m s-1] or other units. + intent(in) :: mask2dCv !< A multiplicative mask of the v-points + type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure + real :: set_v_at_u !< The return value of v at u points points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of v at the u-points. real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -1156,20 +1157,21 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) end function set_v_at_u !> This subroutine finds a thickness-weighted value of u at the v-points. -function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - integer, intent(in) :: i !< The i-index of the u-location to work on. - integer, intent(in) :: j !< The j-index of the u-location to work on. - integer, intent(in) :: k !< The k-index of the u-location to work on. +function set_u_at_v(u, h, G, GV, i, j, k, mask2dCu, OBC) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + integer, intent(in) :: i !< The i-index of the u-location to work on. + integer, intent(in) :: j !< The j-index of the u-location to work on. + integer, intent(in) :: k !< The k-index of the u-location to work on. real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: mask2dCu !< A multiplicative mask of the u-points - type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_u_at_v !< The return value of u at v points in the - !! same units as u, i.e. [L T-1 ~> m s-1] or other units. + intent(in) :: mask2dCu !< A multiplicative mask of the u-points + type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure + real :: set_u_at_v !< The return value of u at v points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of u at the v-points. real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -1208,11 +1210,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have @@ -1255,7 +1257,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real, dimension(SZI_(G),SZJB_(G)) :: & mask_v ! A mask that disables any contributions from v points that ! are land or past open boundary conditions [nondim], 0 or 1. - real :: h_at_vel(SZIB_(G),SZK_(G))! Layer thickness at velocity points, + real :: h_at_vel(SZIB_(G),SZK_(GV))! Layer thickness at velocity points, ! using an upwind-biased second order accurate estimate based ! on the previous velocity direction [H ~> m or kg m-2]. integer :: k_massive(SZIB_(G)) ! The k-index of the deepest layer yet found @@ -1323,7 +1325,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 @@ -1533,7 +1535,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri hwtot = hwtot + hweight if (.not.CS%linear_drag) then - v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) + v_at_u = set_v_at_u(v, h, G, GV, i, j, k, mask_v, OBC) hutot = hutot + hweight * sqrt(u(I,j,k)**2 + & v_at_u**2 + U_bg_sq) endif @@ -1771,7 +1773,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri hwtot = hwtot + hweight if (.not.CS%linear_drag) then - u_at_v = set_u_at_v(u, h, G, i, J, k, mask_u, OBC) + u_at_v = set_u_at_v(u, h, G, GV, i, J, k, mask_u, OBC) hutot = hutot + hweight * sqrt(v(i,J,k)**2 + & u_at_v**2 + U_bg_sq) endif diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index dcd0ac4e02..25b5406449 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -88,18 +88,18 @@ module MOM_sponge subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & Iresttime_i_mean, int_height_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: Iresttime !< The inverse of the restoring time [T-1 ~> s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(in) :: int_height !< The interface heights to damp back toward [Z ~> m]. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZJ_(G)), & optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for !! the zonal mean properties [T-1 ~> s-1]. - real, dimension(SZJ_(G),SZK_(G)+1), & + real, dimension(SZJ_(G),SZK_(GV)+1), & optional, intent(in) :: int_height_i_mean !< The interface heights toward which to !! damp the zonal mean heights [Z ~> m]. @@ -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) @@ -210,16 +210,17 @@ end subroutine init_sponge_diags !> This subroutine stores the reference profile for the variable !! whose address is given by f_ptr. nlay is the number of layers in !! this variable. -subroutine set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: sp_val !< The reference profiles of the quantity being registered. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - target, intent(in) :: f_ptr !< a pointer to the field which will be damped - integer, intent(in) :: nlay !< the number of layers in this quantity - type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that - !! is set by a previous call to initialize_sponge. - real, dimension(SZJ_(G),SZK_(G)),& +subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: sp_val !< The reference profiles of the quantity being registered. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + target, intent(in) :: f_ptr !< a pointer to the field which will be damped + integer, intent(in) :: nlay !< the number of layers in this quantity + type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that + !! is set by a previous call to initialize_sponge. + real, dimension(SZJ_(G),SZK_(GV)),& optional, intent(in) :: sp_val_i_mean !< The i-mean reference value for !! this field with i-mean sponges. @@ -324,14 +325,14 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< An array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< An array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -345,7 +346,7 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) ! there is damping. ! Local variables - real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, ! [H ~> m or kg m-2]. e_D ! Interface heights that are dilated to have a value of 0 @@ -355,18 +356,18 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) ! target value [Z ~> m]. fld_anom ! Anomalies in a tracer concentration, relative to the ! i-mean target value. - real, dimension(SZJ_(G), SZK_(G)+1) :: & + real, dimension(SZJ_(G), SZK_(GV)+1) :: & eta_mean_anom ! The i-mean interface height anomalies [Z ~> m]. real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. - real, dimension(SZI_(G), SZK_(G)+1) :: & + real, dimension(SZI_(G), SZK_(GV)+1) :: & h_above, & ! The total thickness above an interface [H ~> m or kg m-2]. h_below ! The total thickness below an interface [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface [nondim]. - real :: e(SZK_(G)+1) ! The interface heights [Z ~> m], usually negative. + real :: e(SZK_(GV)+1) ! The interface heights [Z ~> m], usually negative. real :: e0 ! The height of the free surface [Z ~> m]. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces @@ -382,7 +383,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..b870dff1af 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -672,26 +672,26 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy !! frequency [T-2 ~> s-2]. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. - real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the + real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the !! interfaces [T-2 ~> s-2]. integer, intent(in) :: j !< The j-index to work on - real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal @@ -720,28 +720,28 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_mixing_cs), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy + real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy !! frequency at the interfaces [T-2 ~> s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! Local variables - real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] - real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] - real, dimension(SZK_(G)+1) :: vert_dep ! vertical deposition - real, dimension(SZK_(G)+1) :: iFaceHeight ! Height of interfaces [m] - real, dimension(SZK_(G)+1) :: SchmittnerSocn - real, dimension(SZK_(G)) :: cellHeight ! Height of cell centers [m] - real, dimension(SZK_(G)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input - ! to model coordinates - real, dimension(SZK_(G)+1) :: N2_int_i ! De-scaled interface buoyancy frequency [s-2] - real, dimension(SZK_(G)) :: Schmittner_coeff - real, dimension(SZK_(G)) :: h_m ! Cell thickness [m] + real, dimension(SZK_(GV)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] + real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] + real, dimension(SZK_(GV)+1) :: vert_dep ! vertical deposition + real, dimension(SZK_(GV)+1) :: iFaceHeight ! Height of interfaces [m] + real, dimension(SZK_(GV)+1) :: SchmittnerSocn + real, dimension(SZK_(GV)) :: cellHeight ! Height of cell centers [m] + real, dimension(SZK_(GV)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input + ! to model coordinates + real, dimension(SZK_(GV)+1) :: N2_int_i ! De-scaled interface buoyancy frequency [s-2] + real, dimension(SZK_(GV)) :: Schmittner_coeff + real, dimension(SZK_(GV)) :: h_m ! Cell thickness [m] real, allocatable, dimension(:,:) :: exp_hab_zetar integer :: i, k, is, ie @@ -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 @@ -944,7 +944,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv deallocate(exp_hab_zetar) case default - call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & "#define CVMIX_TIDAL_SCHEME found in input file.") end select @@ -959,33 +959,33 @@ end subroutine calculate_CVMix_tidal !! Froude-number-depending breaking, PSI, etc.). subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & N2_lay, Kd_lay, Kd_int, Kd_max) - 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)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency - !! frequency [T-2 ~> s-2]. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the - !! layers [T-2 ~> s-2]. - integer, intent(in) :: j !< The j-index to work on - real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE - !! dissipated within a layer and the - !! diapycnal diffusivity within that layer, - !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - real, dimension(SZI_(G),SZK_(G)), & - optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces - !! [Z2 T-1 ~> m2 s-1]. - real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes - !! [Z2 T-1 ~> m2 s-1]. - !! Set this to a negative value to have no limit. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency + !! frequency [T-2 ~> s-2]. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the + !! layers [T-2 ~> s-2]. + integer, intent(in) :: j !< The j-index to work on + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE + !! dissipated within a layer and the + !! diapycnal diffusivity within that layer, + !! usually (~Rho_0 / (G_Earth * dRho_lay)) + !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain + !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] + type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + real, dimension(SZI_(G),SZK_(GV)), & + optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZK_(GV)+1), & + optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces + !! [Z2 T-1 ~> m2 s-1]. + real, intent(in) :: Kd_max !< The maximum increment for diapycnal + !! diffusivity due to TKE-based processes + !! [Z2 T-1 ~> m2 s-1]. + !! Set this to a negative value to have no limit. ! local @@ -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 @@ -1497,7 +1498,7 @@ end subroutine setup_tidal_diagnostics subroutine post_tidal_diagnostics(G, GV, h ,CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(tidal_mixing_cs), pointer :: CS !< The control structure for this module @@ -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 81f8b29a63..40f6ca8c6a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -188,11 +188,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! Local variables - real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. - real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. - real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. + real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. + real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. + real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. + real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress [H ~> m or kg m-2]. @@ -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.") @@ -523,10 +523,10 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) ! Local variables - real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. - real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. + real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. + real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. + real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. + real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness [T H Z-1 ~> s or s kg m-3]. @@ -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.") @@ -636,14 +636,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZK_(GV)) :: & h_harm, & ! Harmonic mean of the thicknesses around a velocity grid point, ! given by 2*(h+ * h-)/(h+ + h-) [H ~> m or kg m-2]. h_arith, & ! The arithmetic mean thickness [H ~> m or kg m-2]. h_delta, & ! The lateral difference of thickness [H ~> m or kg m-2]. hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZK_(G)+1) :: & + real, dimension(SZIB_(G),SZK_(GV)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under @@ -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 @@ -1151,7 +1151,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 @@ -1386,11 +1386,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real :: H_report ! A thickness below which not to report truncations. real :: dt_Rho0 ! The timestep divided by the Boussinesq density [m2 T2 s-1 L-1 Z-1 R-1 ~> s m3 kg-1]. real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] - real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) ! The previous u-velocity [L T-1 ~> m s-1] - real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) ! The previous v-velocity [L T-1 ~> m s-1] + real :: u_old(SZIB_(G),SZJ_(G),SZK_(GV)) ! The previous u-velocity [L T-1 ~> m s-1] + real :: v_old(SZI_(G),SZJB_(G),SZK_(GV)) ! 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 @@ -1475,7 +1475,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS endif if (len_trim(CS%u_trunc_file) > 0) then - do j=js,je; do I=Isq,Ieq ; if (dowrite(I,j)) then + do j=js,je ; do I=Isq,Ieq ; if (dowrite(I,j)) then ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. call write_u_accel(I, j, u_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & @@ -1518,7 +1518,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS endif ; enddo if (trunc_any) then ; if (CS%CFL_based_trunc) then - do k=1,nz; do i=is,ie + do k=1,nz ; do i=is,ie if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 @@ -1560,7 +1560,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS endif if (len_trim(CS%v_trunc_file) > 0) then - do J=Jsq,Jeq; do i=is,ie ; if (dowrite(i,J)) then + do J=Jsq,Jeq ; do i=is,ie ; if (dowrite(i,J)) then ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. call write_v_accel(i, J, v_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & @@ -1610,7 +1610,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 @@ -1758,49 +1758,49 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & - 'Thickness at Zonal Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Thickness at Zonal Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_h_v = register_diag_field('ocean_model', 'Hv_visc', diag%axesCvL, Time, & - 'Thickness at Meridional Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Thickness at Meridional Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, & - 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, & - 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, & - Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_visc > 0) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, & - Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & - Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) + Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & + conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & - Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) + Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & + conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) !CS%id_hf_du_dt_visc = register_diag_field('ocean_model', 'hf_du_dt_visc', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Vertical Viscosity', 'm s-2', & diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 7396a4092a..b9e9196ffa 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -147,7 +147,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< Structure specifying open boundary options. type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -173,7 +173,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & real :: tr_y ! Initial zonally uniform tracer concentrations. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: e(SZK_(G)+1), e_top, e_bot ! Heights [Z ~> m]. + real :: e(SZK_(GV)+1), e_top, e_bot ! Heights [Z ~> m]. real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -269,7 +269,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & ! This is needed to force the compiler not to do a copy in the sponge ! calls. Curses on the designers and implementers of Fortran90. tr_ptr => CS%tr(:,:,:,m) - call set_up_sponge_field(temp, tr_ptr, G, nz, sponge_CSp) + call set_up_sponge_field(temp, tr_ptr, G, GV, nz, sponge_CSp) enddo deallocate(temp) endif @@ -286,15 +286,15 @@ subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -310,9 +310,7 @@ subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, !! fluxes can be applied [H ~> m or kg m-2] ! Local variables - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -338,14 +336,15 @@ end subroutine DOME_tracer_column_physics !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine DOME_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. - type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to DOME_register_tracer. +subroutine DOME_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to DOME_register_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 5503287c50..ce997d6af1 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -153,7 +153,7 @@ subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -179,12 +179,11 @@ subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, pointer :: tr_ptr(:,:,:) => NULL() real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: e(SZK_(G)+1), e_top, e_bot, d_tr integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m 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 @@ -249,15 +248,15 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -276,14 +275,12 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] real :: melt(SZI_(G),SZJ_(G)) ! melt water (positive for melting, negative for freezing) [R Z T-1 ~> kg m-2 s-1] 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 @@ -325,14 +322,15 @@ end subroutine ISOMIP_tracer_column_physics !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine ISOMIP_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. - type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to ISOMIP_register_tracer. +subroutine ISOMIP_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to ISOMIP_register_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index c568f4cacc..3e007cbe7a 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -320,7 +320,7 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -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,31 +359,32 @@ 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) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 - character(len=*), intent(in) :: name !< The tracer name - real, intent(in) :: land_val !< A value the tracer takes over land - real, intent(in) :: IC_val !< The initial condition value for the tracer - type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a - !! previous call to register_OCMIP2_CFC. +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_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: tr !< The tracer concentration array + character(len=*), intent(in) :: name !< The tracer name + real, intent(in) :: land_val !< A value the tracer takes over land + real, intent(in) :: IC_val !< The initial condition value for the tracer + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a + !! previous call to register_OCMIP2_CFC. ! This subroutine initializes a tracer array. 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)//".") @@ -410,15 +411,15 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -441,13 +442,11 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real, dimension(SZI_(G),SZJ_(G)) :: & CFC11_flux, & ! The fluxes of CFC11 and CFC12 into the ocean, in the CFC12_flux ! units of CFC concentrations times meters per second. real, pointer, dimension(:,:,:) :: CFC11 => NULL(), CFC12 => NULL() - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, idim(4), jdim(4) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -496,7 +495,7 @@ end subroutine OCMIP2_CFC_column_physics function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. @@ -542,14 +541,15 @@ end function OCMIP2_CFC_stock !> This subroutine extracts the surface CFC concentrations and other fields that !! are shared with the atmosphere to calculate CFC fluxes. -subroutine OCMIP2_CFC_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. - type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_OCMIP2_CFC. +subroutine OCMIP2_CFC_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_OCMIP2_CFC. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 1ecf9629d8..650e66c47f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -67,22 +67,22 @@ module MOM_generic_tracer !> Control structure for generic tracers type, public :: MOM_generic_tracer_CS ; private - character(len = 200) :: IC_file !< The file in which the generic tracer initial values can - !! be found, or an empty string for internal initialization. - logical :: Z_IC_file !< If true, the generic_tracer IC_file is in Z-space. The default is false. - real :: tracer_IC_val = 0.0 !< The initial value assigned to tracers. - real :: tracer_land_val = -1.0 !< The values of tracers used where land is masked out. - logical :: tracers_may_reinit !< If true, tracers may go through the - !! initialization code if they are not found in the restart files. + character(len = 200) :: IC_file !< The file in which the generic tracer initial values can + !! be found, or an empty string for internal initialization. + logical :: Z_IC_file !< If true, the generic_tracer IC_file is in Z-space. The default is false. + real :: tracer_IC_val = 0.0 !< The initial value assigned to tracers. + real :: tracer_land_val = -1.0 !< The values of tracers used where land is masked out. + logical :: tracers_may_reinit !< If true, tracers may go through the + !! initialization code if they are not found in the restart files. - type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to - !! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Restart control structure + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Restart control structure - !> Pointer to the first element of the linked list of generic tracers. - type(g_tracer_type), pointer :: g_tracer_list => NULL() + !> Pointer to the first element of the linked list of generic tracers. + type(g_tracer_type), pointer :: g_tracer_list => NULL() - integer :: H_to_m !< Auxiliary to access GV%H_to_m in routines that do not have access to GV + integer :: H_to_m !< Auxiliary to access GV%H_to_m in routines that do not have access to GV end type MOM_generic_tracer_CS @@ -235,7 +235,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, 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 - 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_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(in) :: diag !< Regulates diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, @@ -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,& @@ -398,14 +398,14 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< The amount of fluid entrained from the layer !! above during this call [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< The amount of fluid entrained from the layer !! below during this call [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic @@ -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(SZI_(G),SZJ_(G),SZK_(G)) :: h_work + real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke) :: rho_dzt, dzt + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: 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,& @@ -570,7 +570,7 @@ end subroutine MOM_generic_tracer_column_physics function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) 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] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. @@ -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,19 +716,20 @@ 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] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. ! Local variables 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 77176fa047..44e105d1cf 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -145,30 +145,34 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) type(ocean_grid_type), intent(inout) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] real, intent(in) :: dt !< Tracer time step * I_numitts - !! (I_numitts in tracer_hordiff) + !! (I_numitts in tracer_hordiff) [T ~> s] type(tracer_registry_type), pointer :: Reg !< Tracer registry type(lbd_CS), pointer :: CS !< Control structure for this module ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: hbl !< bnd. layer depth [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: uFlx !< Zonal flux of tracer [conc m^3] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vFlx !< Meridional flux of tracer [conc m^3] - 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),SZK_(GV)) :: tendency !< tendency array for diagnostic - real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d !< depth integrated content tendency for diagn - type(tracer_type), pointer :: tracer => NULL() !< Pointer to the current tracer - real, dimension(SZK_(GV)) :: tracer_1d !< 1d-array used to remap tracer change to native grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tracer_old !< local copy of the initial tracer concentration, - !! only used to compute tendencies. - real, dimension(SZI_(G),SZJ_(G)) :: tracer_int, tracer_end - !< integrated tracer in the native grid, before and after - ! LBD is applied. + real, dimension(SZI_(G),SZJ_(G)) :: hbl !< Boundary layer depth [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uFlx !< Zonal flux of tracer [conc H L2 ~> conc kg or conc m^3] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vFlx !< Meridional flux of tracer + !! [conc H L2 ~> conc kg or conc m^3] + real, dimension(SZIB_(G),SZJ_(G)) :: uwork_2d !< Layer summed u-flux transport + !! [conc H L2 ~> conc kg or conc m^3] + real, dimension(SZI_(G),SZJB_(G)) :: vwork_2d !< Layer summed v-flux transport + !! [conc H L2 ~> conc kg or conc m^3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tendency !< tendency array for diagnostic [conc T-1 ~> conc s-1] + real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d !< depth integrated content tendency for diagn + type(tracer_type), pointer :: tracer => NULL() !< Pointer to the current tracer + real, dimension(SZK_(GV)) :: tracer_1d !< 1d-array used to remap tracer change to native grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tracer_old !< local copy of the initial tracer concentration, + !! only used to compute tendencies. + real, dimension(SZI_(G),SZJ_(G)) :: tracer_int !< integrated tracer before LBD is applied + !! [conc H L2 ~> conc m3 or conc kg] + real, dimension(SZI_(G),SZJ_(G)) :: tracer_end !< integrated tracer after LBD is applied. + !! [conc H L2 ~> conc m3 or conc kg] integer :: i, j, k, m !< indices to loop over real :: Idt !< inverse of the time step [s-1] real :: tmp1, tmp2 !< temporary variables @@ -223,6 +227,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) tracer%t(i,j,k) = tracer%t(i,j,k) + (( (uFlx(I-1,j,k)-uFlx(I,j,k)) ) + ( (vFlx(i,J-1,k)-vFlx(i,J,k) ) ))* & G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) if (tracer%id_lbdxy_conc > 0 .or. tracer%id_lbdxy_cont > 0 .or. tracer%id_lbdxy_cont_2d > 0 ) then + !### Probably this needs to be multiplied by (h(i,j,k) + GV%H_subroundoff) for consistency + ! the way it is used later in this routine. tendency(i,j,k) = (tracer%t(i,j,k)-tracer_old(i,j,k)) * Idt endif endif @@ -249,8 +255,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) endif ! Post the tracer diagnostics - if (tracer%id_lbd_dfx>0) call post_data(tracer%id_lbd_dfx, uFlx*Idt, CS%diag) - if (tracer%id_lbd_dfy>0) call post_data(tracer%id_lbd_dfy, vFlx*Idt, CS%diag) + if (tracer%id_lbd_dfx>0) call post_data(tracer%id_lbd_dfx, uFlx(:,:,:)*Idt, CS%diag) + if (tracer%id_lbd_dfy>0) call post_data(tracer%id_lbd_dfy, vFlx(:,:,:)*Idt, CS%diag) if (tracer%id_lbd_dfx_2d>0) then uwork_2d(:,:) = 0. do k=1,GV%ke ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec @@ -268,6 +274,7 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) endif ! post tendency of tracer content + !### This seems to be dimensionally inconsistent with the calculation of tendency above. if (tracer%id_lbdxy_cont > 0) then call post_data(tracer%id_lbdxy_cont, tendency, CS%diag) endif @@ -286,6 +293,7 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) ! post tendency of tracer concentration; this step must be ! done after posting tracer content tendency, since we alter ! the tendency array and its units. + !### This seems to be dimensionally inconsistent with the calculation of tendency above. if (tracer%id_lbdxy_conc > 0) then do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec tendency(i,j,k) = tendency(i,j,k) / ( h(i,j,k) + CS%H_subroundoff ) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 873e9f8247..50ce18eb57 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -112,9 +112,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 @@ -242,25 +243,25 @@ 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 - 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. + CS%nsurf = 2*GV%ke+2 ! Continuous reconstruction means that every interface has two connections + allocate(CS%dRdT(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%dRdT(:,:,:) = 0. + allocate(CS%dRdS(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%dRdS(:,:,:) = 0. else - CS%nsurf = 4*G%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. - allocate(CS%dRdT_i(SZI_(G),SZJ_(G),SZK_(G),2)) ; CS%dRdT_i(:,:,:,:) = 0. - allocate(CS%dRdS_i(SZI_(G),SZJ_(G),SZK_(G),2)) ; CS%dRdS_i(:,:,:,:) = 0. - allocate(CS%ppoly_coeffs_T(SZI_(G),SZJ_(G),SZK_(G),CS%deg+1)) ; CS%ppoly_coeffs_T(:,:,:,:) = 0. - allocate(CS%ppoly_coeffs_S(SZI_(G),SZJ_(G),SZK_(G),CS%deg+1)) ; CS%ppoly_coeffs_S(:,:,:,:) = 0. + CS%nsurf = 4*GV%ke ! Discontinuous means that every interface has four connections + allocate(CS%T_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%T_i(:,:,:,:) = 0. + allocate(CS%S_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%S_i(:,:,:,:) = 0. + allocate(CS%P_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%P_i(:,:,:,:) = 0. + allocate(CS%dRdT_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%dRdT_i(:,:,:,:) = 0. + allocate(CS%dRdS_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%dRdS_i(:,:,:,:) = 0. + allocate(CS%ppoly_coeffs_T(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1)) ; CS%ppoly_coeffs_T(:,:,:,:) = 0. + allocate(CS%ppoly_coeffs_S(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1)) ; CS%ppoly_coeffs_S(:,:,:,:) = 0. allocate(CS%ns(SZI_(G),SZJ_(G))) ; CS%ns(:,:) = 0. endif ! T-points - allocate(CS%Tint(SZI_(G),SZJ_(G),SZK_(G)+1)) ; CS%Tint(:,:,:) = 0. - allocate(CS%Sint(SZI_(G),SZJ_(G),SZK_(G)+1)) ; CS%Sint(:,:,:) = 0. - allocate(CS%Pint(SZI_(G),SZJ_(G),SZK_(G)+1)) ; CS%Pint(:,:,:) = 0. - allocate(CS%stable_cell(SZI_(G),SZJ_(G),SZK_(G))) ; CS%stable_cell(:,:,:) = .true. + allocate(CS%Tint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Tint(:,:,:) = 0. + allocate(CS%Sint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Sint(:,:,:) = 0. + allocate(CS%Pint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Pint(:,:,:) = 0. + allocate(CS%stable_cell(SZI_(G),SZJ_(G),SZK_(GV))) ; CS%stable_cell(:,:,:) = .true. ! U-points allocate(CS%uPoL(G%isd:G%ied,G%jsd:G%jed, CS%nsurf)); CS%uPoL(G%isc-1:G%iec,G%jsc:G%jec,:) = 0. allocate(CS%uPoR(G%isd:G%ied,G%jsd:G%jed, CS%nsurf)); CS%uPoR(G%isc-1:G%iec,G%jsc:G%jec,:) = 0. @@ -279,13 +280,13 @@ end function neutral_diffusion_init !> Calculate remapping factors for u/v columns used to map adjoining columns to !! a shared coordinate space. subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S !< Salinity [ppt] - type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S !< Salinity [ppt] + type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: p_surf !< Surface pressure to include in pressures used !! for equation of state calculations [R L2 T-2 ~> Pa] @@ -293,7 +294,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k ! Variables used for reconstructions - real, dimension(SZK_(G),2) :: ppoly_r_S ! Reconstruction slopes + real, dimension(SZK_(GV),2) :: ppoly_r_S ! Reconstruction slopes real, dimension(SZI_(G), SZJ_(G)) :: hEff_sum ! Summed effective face thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth [H ~> m or kg m-2] integer :: iMethod @@ -320,8 +321,8 @@ 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)) - enddo; enddo + 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 @@ -352,13 +353,13 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! Calculate pressure at interfaces and layer averaged alpha/beta if (present(p_surf)) then - do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - CS%Pint(i,j,1) = p_surf(i,j) - enddo ; enddo + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + CS%Pint(i,j,1) = p_surf(i,j) + enddo ; enddo 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 @@ -376,7 +377,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 @@ -387,16 +388,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. ) @@ -407,13 +408,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), & @@ -428,7 +429,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. @@ -454,13 +455,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,:,:), & @@ -475,13 +476,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,:,:), & @@ -526,7 +527,7 @@ end subroutine neutral_diffusion_calc_coeffs subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] real, intent(in) :: dt !< Tracer time step * I_numitts [T ~> s] @@ -539,11 +540,14 @@ 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 diagnostics + ! [H conc T-1 ~> m conc s-1 or kg m-2 conc s-1] real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn + ! [H conc T-1 ~> m conc s-1 or kg m-2 conc s-1] 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 + ! [H L2 conc ~> m3 conc or kg conc] type(tracer_type), pointer :: Tracer => NULL() ! Pointer to the current tracer @@ -656,7 +660,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) call post_data(tracer%id_dfy_2d, trans_y_2d(:,:), CS%diag) endif - ! post tendency of tracer content + ! post tendency of layer-integrated tracer content if (tracer%id_dfxy_cont > 0) then call post_data(tracer%id_dfxy_cont, tendency(:,:,:), CS%diag) endif diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 119ad555da..6900f76fa5 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -45,13 +45,13 @@ module MOM_offline_aux subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: uhtr !< Accumulated mass flux through zonal face [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: vhtr !< Accumulated mass flux through meridional face [kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Previous layer thicknesses [kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. ! Local variables @@ -83,16 +83,16 @@ end subroutine update_h_horizontal_flux subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< Mass of fluid entrained from the layer !! above within this timestep [kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< Mass of fluid entrained from the layer !! below within this timestep [kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous !! step [kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. ! Local variables @@ -136,23 +136,23 @@ end subroutine update_h_vertical_flux subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: uh !< Mass flux through zonal face [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vh !< Mass flux through meridional face [kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< Mass of fluid entrained from the layer !! above within this timestep [kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< Mass of fluid entrained from the layer !! below within this timestep [kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous !! step [kg m-2]. ! Local variables integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux, bottom_flux real :: pos_flux, hvol, h_neglect, scale_factor, max_off_cfl max_off_cfl =0.5 @@ -239,15 +239,15 @@ end subroutine limit_mass_flux_3d subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end !! of the previous timestep [kg] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: uh !< Zonal mass transport within a timestep [kg] - real, dimension(SZIB_(G),SZK_(G)) :: uh2d + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d real, dimension(SZIB_(G)) :: uh2d_sum - real, dimension(SZI_(G),SZK_(G)) :: h2d + real, dimension(SZI_(G),SZK_(GV)) :: h2d real, dimension(SZI_(G)) :: h2d_sum integer :: i, j, k, m, is, ie, js, je, nz @@ -310,15 +310,15 @@ end subroutine distribute_residual_uh_barotropic subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end !! of the previous timestep [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vh !< Meridional mass transport within a timestep [kg] - real, dimension(SZJB_(G),SZK_(G)) :: vh2d + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(G)) :: h2d + real, dimension(SZJ_(G),SZK_(GV)) :: h2d real, dimension(SZJ_(G)) :: h2d_sum integer :: i, j, k, m, is, ie, js, je, nz @@ -383,14 +383,14 @@ end subroutine distribute_residual_vh_barotropic subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end !! of the previous timestep [kg] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: uh !< Zonal mass transport within a timestep [kg] - real, dimension(SZIB_(G),SZK_(G)) :: uh2d - real, dimension(SZI_(G),SZK_(G)) :: h2d + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d + real, dimension(SZI_(G),SZK_(GV)) :: h2d real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max real :: hup, hdown, hlos, min_h @@ -479,15 +479,15 @@ end subroutine distribute_residual_uh_upwards subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end !! of the previous timestep [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vh !< Meridional mass transport within a timestep [kg] - real, dimension(SZJB_(G),SZK_(G)) :: vh2d + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(G)) :: h2d + real, dimension(SZJ_(G),SZK_(GV)) :: h2d real, dimension(SZJ_(G)) :: h2d_sum real :: vh_neglect, vh_remain, vh_col, vh_sum @@ -635,19 +635,19 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ character(len=*), intent(in ) :: sum_file !< Name of file with summed fields character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields character(len=*), intent(in ) :: surf_file !< Name of file with surface fields - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: uhtr !< Zonal mass fluxes [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: vhtr !< Meridional mass fluxes [kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h_end !< End of timestep layer thickness - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: temp_mean !< Averaged temperature - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: salt_mean !< Averaged salinity real, dimension(SZI_(G),SZJ_(G)), & intent(inout) :: mld !< Averaged mixed layer depth - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: Kd !< Diapycnal diffusivities at interfaces type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files @@ -769,14 +769,14 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_ character(len=200), intent(in ) :: mean_file !< Name of file with averages fields character(len=200), intent(in ) :: sum_file !< Name of file with summed fields character(len=200), intent(in ) :: snap_file !< Name of file with snapshot fields - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes [kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hend !< End of timestep layer thickness [kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hend !< End of timestep layer thickness [kg m-2] real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes [kg] real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [kg] real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness [kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: temp !< Temperature array - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: salt !< Salinity array + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 3895e8a116..408120b4e5 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -212,12 +212,12 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock real, intent(in) :: time_interval !< time interval type(offline_transport_CS), pointer :: CS !< control structure for offline module integer, intent(in) :: id_clock_ALE !< Clock for ALE routines - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & intent(inout) :: h_pre !< layer thicknesses before advection !! [H ~> m or kg m-2] - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & intent(inout) :: uhtr !< Zonal mass transport [H m2 ~> m3 or kg] - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), & + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), & intent(inout) :: vhtr !< Meridional mass transport [H m2 ~> m3 or kg] logical, intent( out) :: converged !< True if the iterations have converged @@ -227,14 +227,14 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid ! Work arrays for mass transports - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhtr_sub ! Meridional mass transports - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhtr_sub real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & h_new, & h_vol ! Fields for eta_diff diagnostic @@ -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,11 +366,11 @@ 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 - do k=1,nz; do j=js,je ; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie uhtr_sub(I,j,k) = uhtr(I,j,k) vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo @@ -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) @@ -421,11 +421,11 @@ end subroutine offline_advection_ale !! eventually work down the entire water column subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & intent(inout) :: h_pre !< layer thicknesses before advection - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & intent(inout) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), & + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), & intent(inout) :: vhtr !< Meridional mass transport logical, intent(in ) :: converged !< True if the iterations have converged @@ -435,14 +435,14 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! about the vertical grid logical :: x_before_y ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & h_new, & h_vol ! Used to calculate the eta diagnostics real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_work - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhr !< Meridional mass transport + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhr !< Zonal mass transport + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhr !< Meridional mass transport character(len=256) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, iter @@ -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) @@ -617,8 +617,8 @@ end subroutine offline_redistribute_residual !> Sums any non-negligible remaining transport to check for advection convergence real function remaining_transport_sum(CS, uhtr, vhtr) type(offline_transport_CS), pointer :: CS !< control structure for offline module - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(in ) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(in ) :: vhtr !< Meridional mass transport + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(in ) :: uhtr !< Zonal mass transport + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(in ) :: vhtr !< Meridional mass transport ! Local variables integer :: i, j, k @@ -633,7 +633,7 @@ real function remaining_transport_sum(CS, uhtr, vhtr) h_min = CS%GV%H_subroundoff remaining_transport_sum = 0. - do k=1,nz; do j=js,je ; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie uh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) vh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) if (ABS(uhtr(I,j,k))>uh_neglect) then @@ -656,11 +656,11 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type type(time_type), intent(in) :: Time_end !< time interval type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & @@ -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) @@ -761,7 +761,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< Surface fluxes container - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: in_flux_optional !< The total time-integrated amount @@ -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 @@ -811,7 +811,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< Surface fluxes container - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: out_flux_optional !< The total time-integrated amount @@ -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 @@ -847,35 +847,35 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_interval !< Offline transport time interval type(offline_transport_CS), pointer :: CS !< Control structure for offline module - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre !< layer thicknesses before advection - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: eatr !< Entrainment from layer above - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: ebtr !< Entrainment from layer below - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(inout) :: vhtr !< Meridional mass transport + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_pre !< layer thicknesses before advection + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: eatr !< Entrainment from layer above + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: ebtr !< Entrainment from layer below + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: uhtr !< Zonal mass transport + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(inout) :: vhtr !< Meridional mass transport ! Local pointers type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid ! Remaining zonal mass transports - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhtr_sub ! Remaining meridional mass transports - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhtr_sub real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are real :: dt_offline ! Local variables ! Vertical diffusion related variables - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & eatr_sub, & ebtr_sub ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & h_new, & h_vol ! Work arrays for temperature and salinity - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & temp_old, salt_old, & temp_mean, salt_mean, & zero_3dh ! @@ -990,7 +990,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, sum_abs_fluxes = 0.0 sum_u = 0.0 sum_v = 0.0 - do k=1,nz; do j=js,je; do i=is,ie + do k=1,nz ; do j=js,je ; do i=is,ie sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & @@ -1017,12 +1017,12 @@ end subroutine offline_advection_layer !! read during initialization. Then if in an ALE-dependent coordinate, regrid/remap fields. subroutine update_offline_fields(CS, h, fluxes, do_ale) type(offline_transport_CS), pointer :: CS !< Control structure for offline module - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h !< The regridded layer thicknesses + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: h !< The regridded layer thicknesses type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields logical, intent(in ) :: do_ale !< True if using ALE ! Local variables integer :: i, j, k, is, ie, js, je, nz - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h_start + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: h_start is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec ; nz = CS%GV%ke call cpu_clock_begin(CS%id_clock_read_fields) @@ -1170,10 +1170,10 @@ end subroutine register_diags_offline_transport !> Posts diagnostics related to offline convergence diagnostics subroutine post_offline_convergence_diags(CS, h_off, h_end, uhtr, vhtr) type(offline_transport_CS), intent(in ) :: CS !< Offline control structure - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_off !< Thicknesses at end of offline step - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_end !< Stored thicknesses - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: uhtr !< Remaining zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(inout) :: vhtr !< Remaining meridional mass transport + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_off !< Thicknesses at end of offline step + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_end !< Stored thicknesses + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: uhtr !< Remaining zonal mass transport + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(inout) :: vhtr !< Remaining meridional mass transport real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff integer :: i, j, k diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index ac6242785e..1e79061dcd 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,13 +28,14 @@ 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: tr !< The tracer to initialize - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] character(len=*), intent(in) :: filename !< The name of the file to read from character(len=*), intent(in) :: tr_name !< The name of the tracer in the file @@ -62,7 +64,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) z2 ! of a z-cell that contributes to a layer, relative to the cell ! center and normalized by the cell thickness, nondim. ! Note that -1/2 <= z1 <= z2 <= 1/2. - real :: e(SZK_(G)+1) ! The z-star interface heights [Z ~> m]. + real :: e(SZK_(GV)+1) ! The z-star interface heights [Z ~> m]. real :: landval ! The tracer value to use in land points. real :: sl_tr ! The normalized slope of the tracer ! within the cell, in tracer units. @@ -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,18 +612,20 @@ 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: temp !< potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: salt !< salinity [PSU] - real, dimension(SZK_(G)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. + real, dimension(SZK_(GV)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) real, intent(in) :: land_fill !< land fill value - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thickness, used only to avoid working on !! massless layers [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -631,7 +635,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, real, parameter :: T_max = 31.0, T_min = -2.0 ! Local variables (All of which need documentation!) - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & T, S, dT, dS, & rho, & ! Layer densities [R ~> kg m-3] hin, & ! Input layer thicknesses [H ~> m or kg m-2] @@ -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_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index e9c8fb0e7b..f3e80c791e 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -51,37 +51,37 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: h_prev_opt !< layer thickness before advection [H ~> m or kg m-2] integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update !! first in the x- or y-direction. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & hprev ! cell volume at the end of previous tracer change [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & uhr ! The remaining zonal thickness flux [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & vhr ! The remaining meridional thickness fluxes [H L2 ~> m3 or kg] real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that @@ -89,12 +89,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & real :: landvolfill ! An arbitrary? nonzero cell volume [H L2 ~> m3 or kg]. real :: Idt ! 1/dt [T-1 ~> s-1]. - logical :: domore_u(SZJ_(G),SZK_(G)) ! domore__ indicate whether there is more - logical :: domore_v(SZJB_(G),SZK_(G)) ! advection to be done in the corresponding - ! row or column. + logical :: domore_u(SZJ_(G),SZK_(GV)) ! domore_u and domore_v indicate whether there is more + logical :: domore_v(SZJB_(G),SZK_(GV)) ! advection to be done in the corresponding row or column. logical :: x_first ! If true, advect in the x-direction first. integer :: max_iter ! maximum number of iterations in each layer - integer :: domore_k(SZK_(G)) + integer :: domore_k(SZK_(GV)) integer :: stencil ! stencil of the advection scheme integer :: nsten_halo ! number of stencils that fit in the halos integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, itt, ntr, do_any @@ -224,12 +223,12 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & !$OMP parallel do default(shared) do k=1,nz ; if (domore_k(k) > 0) then do j=jsv,jev ; if (.not.domore_u(j,k)) then - do i=isv+stencil-1,iev-stencil; if (uhr(I,j,k) /= 0.0) then + do i=isv+stencil-1,iev-stencil ; if (uhr(I,j,k) /= 0.0) then domore_u(j,k) = .true. ; exit endif ; enddo ! i-loop endif ; enddo do J=jsv+stencil-1,jev-stencil ; if (.not.domore_v(J,k)) then - do i=isv+stencil,iev-stencil; if (vhr(i,J,k) /= 0.0) then + do i=isv+stencil,iev-stencil ; if (vhr(i,J,k) /= 0.0) then domore_v(J,k) = .true. ; exit endif ; enddo ! i-loop endif ; enddo @@ -339,14 +338,14 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hprev !< cell volume at the end of previous !! tracer change [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhr !< accumulated volume/mass flux through !! the zonal face [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uh_neglect !< A tiny zonal mass flux that can + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uh_neglect !< A tiny zonal mass flux that can !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used - logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be + logical, dimension(SZJ_(G),SZK_(GV)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row real, intent(in) :: Idt !< The inverse of dt [T-1 ~> s-1] integer, intent(in) :: ntr !< The number of tracers @@ -391,7 +390,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real :: fac1,u_L_in,u_L_out ! terms used for time-stepping OBC reservoirs type(OBC_segment_type), pointer :: segment=>NULL() logical :: usePLMslope - logical, dimension(SZJ_(G),SZK_(G)) :: domore_u_initial + logical, dimension(SZJ_(G),SZK_(GV)) :: domore_u_initial ! keep a local copy of the initial values of domore_u, which is to be used when computing ad2d_x ! diagnostic at the end of this subroutine. @@ -444,41 +443,41 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ! loop through open boundaries and recalculate flux terms if (associated(OBC)) then ; if (OBC%OBC_pe) then - do n=1,OBC%number_of_segments - segment=>OBC%segment(n) - if (.not. associated(segment%tr_Reg)) cycle - if (segment%is_E_or_W) then - if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then - I = segment%HI%IsdB - do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then - if (segment%direction == OBC_DIRECTION_W) then - T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) - else - T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) - endif + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + if (segment%is_E_or_W) then + if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then + I = segment%HI%IsdB + do m = 1,ntr ! replace tracers with OBC values + if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (segment%direction == OBC_DIRECTION_W) then + T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) else - if (segment%direction == OBC_DIRECTION_W) then - T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - else - T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - endif + T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) endif + else + if (segment%direction == OBC_DIRECTION_W) then + T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + else + T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do i=segment%HI%IsdB-1,segment%HI%IsdB+1 + Tp = T_tmp(i+1,m) ; Tc = T_tmp(i,m) ; Tm = T_tmp(i-1,m) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_x(i,m) = G%mask2dCu(I,j)*G%mask2dCu(I-1,j) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) enddo - do m = 1,ntr ! Apply update tracer values for slope calculation - do i=segment%HI%IsdB-1,segment%HI%IsdB+1 - Tp = T_tmp(i+1,m) ; Tc = T_tmp(i,m) ; Tm = T_tmp(i-1,m) - dMx = max( Tp, Tc, Tm ) - Tc - dMn= Tc - min( Tp, Tc, Tm ) - slope_x(i,m) = G%mask2dCu(I,j)*G%mask2dCu(I-1,j) * & - sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) - enddo - enddo + enddo - endif - endif - enddo - endif; endif + endif + endif + enddo + endif ; endif ! Calculate the i-direction fluxes of each tracer, using as much @@ -591,7 +590,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows from masked areas. ! Now changing to simply fixed inflows. if ((uhr(I,j,k) > 0.0) .and. (segment%direction == OBC_DIRECTION_W) .or. & - (uhr(I,j,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_E)) then + (uhr(I,j,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_E)) then uhh(I) = uhr(I,j,k) ! should the reservoir evolve for this case Kate ?? - Nope do m=1,ntr @@ -615,7 +614,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows from masked areas. if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & - (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then + (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then uhh(I) = uhr(I,j,k) do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then @@ -704,14 +703,14 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hprev !< cell volume at the end of previous !! tracer change [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhr !< accumulated volume/mass flux through !! the meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used - logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be + logical, dimension(SZJB_(G),SZK_(GV)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row real, intent(in) :: Idt !< The inverse of dt [T-1 ~> s-1] integer, intent(in) :: ntr !< The number of tracers @@ -814,42 +813,42 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! loop through open boundaries and recalculate flux terms if (associated(OBC)) then ; if (OBC%OBC_pe) then - do n=1,OBC%number_of_segments - segment=>OBC%segment(n) - if (.not. associated(segment%tr_Reg)) cycle - do i=is,ie - if (segment%is_N_or_S) then - if (i>=segment%HI%isd .and. i<=segment%HI%ied) then - J = segment%HI%JsdB - do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then - if (segment%direction == OBC_DIRECTION_S) then - T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) - else - T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k) - endif + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + do i=is,ie + if (segment%is_N_or_S) then + if (i>=segment%HI%isd .and. i<=segment%HI%ied) then + J = segment%HI%JsdB + do m = 1,ntr ! replace tracers with OBC values + if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (segment%direction == OBC_DIRECTION_S) then + T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) else - if (segment%direction == OBC_DIRECTION_S) then - T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - else - T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - endif + T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k) endif + else + if (segment%direction == OBC_DIRECTION_S) then + T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + else + T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do j=segment%HI%JsdB-1,segment%HI%JsdB+1 + Tp = T_tmp(i,m,j+1) ; Tc = T_tmp(i,m,j) ; Tm = T_tmp(i,m,j-1) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) enddo - do m = 1,ntr ! Apply update tracer values for slope calculation - do j=segment%HI%JsdB-1,segment%HI%JsdB+1 - Tp = T_tmp(i,m,j+1) ; Tc = T_tmp(i,m,j) ; Tm = T_tmp(i,m,j-1) - dMx = max( Tp, Tc, Tm ) - Tc - dMn= Tc - min( Tp, Tc, Tm ) - slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * & - sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) - enddo - enddo - endif - endif ! is_N_S - enddo ! i-loop - enddo ! segment loop - endif; endif + enddo + endif + endif ! is_N_S + enddo ! i-loop + enddo ! segment loop + endif ; endif ! Calculate the j-direction fluxes of each tracer, using as much ! the minimum of the remaining mass flux (vhr) and the half the mass @@ -964,7 +963,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows from masked areas. ! Now changing to simply fixed inflows. if ((vhr(i,J,k) > 0.0) .and. (segment%direction == OBC_DIRECTION_S) .or. & - (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then + (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%t)) then @@ -999,7 +998,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif enddo endif - endif; endif + endif ; endif else ! not domore_v. do i=is,ie ; vhh(i,J) = 0.0 ; enddo diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 6b9a12f696..567fa2897e 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -86,16 +86,16 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%m_to_H !$OMP parallel default(shared) private(sink,h_minus_dsink,b_denom_1,b1,d1,h_tr,c1) !$OMP do - do j=js,je; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo ; enddo + do j=js,je ; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo ; enddo if (present(sfc_flux)) then if (convert_flux) then !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H enddo ; enddo else !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie sfc_src(i,j) = sfc_flux(i,j) enddo ; enddo endif @@ -103,12 +103,12 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (present(btm_flux)) then if (convert_flux) then !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie btm_src(i,j) = (btm_flux(i,j)*dt) * GV%kg_m2_to_H enddo ; enddo else !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie btm_src(i,j) = btm_flux(i,j) enddo ; enddo endif @@ -286,16 +286,16 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%m_to_H !$OMP parallel default(shared) private(sink,h_minus_dsink,b_denom_1,b1,d1,h_tr,c1) !$OMP do - do j=js,je; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo ; enddo + do j=js,je ; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo ; enddo if (present(sfc_flux)) then if (convert_flux) then !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H enddo ; enddo else !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie sfc_src(i,j) = sfc_flux(i,j) enddo ; enddo endif @@ -303,12 +303,12 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & if (present(btm_flux)) then if (convert_flux) then !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie btm_src(i,j) = (btm_flux(i,j)*dt) * GV%kg_m2_to_H enddo ; enddo else !$OMP do - do j = js, je; do i = is,ie + do j=js,je ; do i=is,ie btm_src(i,j) = btm_flux(i,j) enddo ; enddo endif @@ -427,10 +427,10 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim type(ocean_grid_type), intent(in ) :: G !< Grid structure type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Tr !< Tracer concentration on T-cell + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: Tr !< Tracer concentration on T-cell real, intent(in ) :: dt !< Time-step over which forcing is applied [T ~> s] type(forcing), intent(in ) :: fluxes !< Surface fluxes container - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in ) :: evap_CFL_limit !< Limit on the fraction of the !! water that can be fluxed out of the top !! layer in a timestep [nondim] @@ -454,7 +454,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim netMassIn, & ! mass entering ocean surface [H ~> m or kg m-2] over a time step netMassOut ! mass leaving ocean surface [H ~> m or kg m-2] over a time step - real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d + real, dimension(SZI_(G),SZK_(GV)) :: h2d, Tr2d real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! ! that enters with freshwater real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! @@ -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..26ef197ae2 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -332,9 +332,10 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag end subroutine tracer_flow_control_init !> This subroutine extracts the chlorophyll concentrations from the model state, if possible -subroutine get_chl_from_model(Chl_array, G, CS) +subroutine get_chl_from_model(Chl_array, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: Chl_array !< The array in which to store the model's !! Chlorophyll-A concentrations in mg m-3. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a @@ -722,11 +723,12 @@ 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. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to call_tracer_register. @@ -736,23 +738,23 @@ subroutine call_tracer_surface_state(sfc_state, h, G, CS) ! Add other user-provided calls here. if (CS%use_USER_tracer_example) & - call USER_tracer_surface_state(sfc_state, h, G, CS%USER_tracer_example_CSp) + call USER_tracer_surface_state(sfc_state, h, G, GV, CS%USER_tracer_example_CSp) if (CS%use_DOME_tracer) & - call DOME_tracer_surface_state(sfc_state, h, G, CS%DOME_tracer_CSp) + call DOME_tracer_surface_state(sfc_state, h, G, GV, CS%DOME_tracer_CSp) if (CS%use_ISOMIP_tracer) & - call ISOMIP_tracer_surface_state(sfc_state, h, G, CS%ISOMIP_tracer_CSp) + call ISOMIP_tracer_surface_state(sfc_state, h, G, GV, CS%ISOMIP_tracer_CSp) if (CS%use_ideal_age) & - call ideal_age_tracer_surface_state(sfc_state, h, G, CS%ideal_age_tracer_CSp) + call ideal_age_tracer_surface_state(sfc_state, h, G, GV, CS%ideal_age_tracer_CSp) if (CS%use_regional_dyes) & - call dye_tracer_surface_state(sfc_state, h, G, CS%dye_tracer_CSp) + call dye_tracer_surface_state(sfc_state, h, G, GV, CS%dye_tracer_CSp) if (CS%use_oil) & - call oil_tracer_surface_state(sfc_state, h, G, CS%oil_tracer_CSp) + call oil_tracer_surface_state(sfc_state, h, G, GV, CS%oil_tracer_CSp) if (CS%use_advection_test_tracer) & - call advection_test_tracer_surface_state(sfc_state, h, G, CS%advection_test_tracer_CSp) + call advection_test_tracer_surface_state(sfc_state, h, G, GV, CS%advection_test_tracer_CSp) if (CS%use_OCMIP2_CFC) & - call OCMIP2_CFC_surface_state(sfc_state, h, G, CS%OCMIP2_CFC_CSp) + call OCMIP2_CFC_surface_state(sfc_state, h, G, GV, 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 339a5ed491..eb59dcc74f 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -105,12 +105,12 @@ module MOM_tracer_hor_diff !! on the acceptable time increment. subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers @@ -588,7 +588,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & GV, US, CS, tv, num_itts) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] type(tracer_type), intent(inout) :: Tr(:) !< tracer array integer, intent(in) :: ntr !< number of tracers @@ -626,18 +626,18 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Lv, k0a_Lv, & ! The original k-indices of the layers that participate k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & tr_flux_conv ! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg] - real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R + real, dimension(SZI_(G), SZJ_(G),SZK_(GV)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R - real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & + real, dimension(SZI_(G),SZK_(GV), SZJ_(G)) :: & rho_srt, & ! The density of each layer of the sorted columns [R ~> kg m-3]. h_srt ! The thickness of each layer of the sorted columns [H ~> m or kg m-2]. - integer, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & + integer, dimension(SZI_(G),SZK_(GV), SZJ_(G)) :: & k0_srt ! The original k-index that each layer of the sorted column ! corresponds to. - real, dimension(SZK_(G)) :: & + real, dimension(SZK_(GV)) :: & h_demand_L, & ! The thickness in the left (_L) or right (_R) column that h_demand_R, & ! is demanded to match the thickness in the counterpart [H ~> m or kg m-2]. h_used_L, & ! The summed thickness from the left or right columns that @@ -676,10 +676,10 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & ! The total number of pairings is usually much less than twice the number of layers, but ! the memory in these 1-d columns of pairings can be allocated generously for safety. - integer, dimension(SZK_(G)*2) :: & + integer, dimension(SZK_(GV)*2) :: & kbs_Lp, & ! The sorted indices of the Left and Right columns for kbs_Rp ! each pairing. - logical, dimension(SZK_(G)*2) :: & + logical, dimension(SZK_(GV)*2) :: & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. @@ -776,7 +776,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & ! Sort each column by increasing density. This should already be close, ! and the size of the arrays are small, so straight insertion is used. !$OMP do - do j=js-1,je+1; do i=is-1,ie+1 + do j=js-1,je+1 ; do i=is-1,ie+1 do k=2,num_srt(i,j) ; if (rho_srt(i,k,j) < rho_srt(i,k-1,j)) then ! The last segment needs to be shuffled earlier in the list. do k2 = k,2,-1 ; if (rho_srt(i,k2,j) >= rho_srt(i,k2-1,j)) exit @@ -1508,7 +1508,7 @@ subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic 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!") @@ -1530,19 +1530,19 @@ subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic CS%id_CFL = -1 CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time, & - 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & - cmor_field_name='diftrelo', & - cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & - cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') + 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & + cmor_field_name='diftrelo', & + cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & + cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') CS%id_khdt_x = register_diag_field('ocean_model', 'KHDT_x', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) + 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) CS%id_khdt_y = register_diag_field('ocean_model', 'KHDT_y', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) + 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) if (CS%check_diffusive_CFL) then CS%id_CFL = register_diag_field('ocean_model', 'CFL_lateral_diff', diag%axesT1, Time,& 'Grid CFL number for lateral/neutral tracer diffusion', 'nondim') diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index cb8f1716fe..cfbdc6ecb0 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -58,25 +58,26 @@ module MOM_tracer_registry real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !### These two arrays may be allocated but are never used. real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] ! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux -! !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] +! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] ! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux -! !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] +! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] @@ -88,6 +89,7 @@ module MOM_tracer_registry !! timestep used for diagnostics [conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array !! at a previous timestep used for diagnostics + !! [conc H ~> conc m or conc kg m-2] character(len=32) :: name !< tracer name used for diagnostics and error messages character(len=64) :: units !< Physical dimensions of the tracer concentration @@ -371,7 +373,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 @@ -692,10 +694,10 @@ subroutine postALE_tracer_diagnostics(Reg, G, GV, diag, dt) type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output real, intent(in) :: dt !< total time interval for these diagnostics [T ~> s] - real :: work(SZI_(G),SZJ_(G),SZK_(G)) + real :: work(SZI_(G),SZJ_(G),SZK_(GV)) 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 +731,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 +781,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 +813,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,19 +822,20 @@ 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) - character(len=*), intent(in) :: mesg !< message that appears on the chksum lines - type(ocean_grid_type), intent(in) :: G !< ocean 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 - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: tr_inv !< Tracer inventory +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_(GV)), intent(in) :: h !< Layer thicknesses + integer, intent(in) :: ntr !< number of registered tracers + + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tr_inv !< Tracer inventory real :: total_inv 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..59058abeda 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -159,7 +159,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness, in m or kg m-2. type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -185,13 +185,12 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, pointer :: tr_ptr(:,:,:) => NULL() real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg-2]. - real :: e(SZK_(G)+1), e_top, e_bot, d_tr ! Heights [Z ~> m]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB 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 @@ -238,11 +237,11 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then temp(i,j,k) = 0.0 endif - enddo ; enddo; enddo + enddo ; enddo ; enddo do m=1,1 ! This is needed to force the compiler not to do a copy in the sponge calls. tr_ptr => CS%tr(:,:,:,m) - call set_up_ALE_sponge_field(temp, G, tr_ptr, sponge_CSp) + call set_up_ALE_sponge_field(temp, G, GV, tr_ptr, sponge_CSp) enddo deallocate(temp) endif @@ -254,10 +253,10 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then temp(i,j,k) = 0.0 endif - enddo ; enddo; enddo + enddo ; enddo ; enddo do m=1,1 tr_ptr => CS%tr(:,:,:,m) - call set_up_sponge_field(temp, tr_ptr, G, nz, layer_CSp) + call set_up_sponge_field(temp, tr_ptr, G, GV, nz, layer_CSp) enddo deallocate(temp) endif @@ -276,15 +275,15 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -301,23 +300,21 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] real :: in_flux(SZI_(G),SZJ_(G),2) ! total amount of tracer to be injected integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return in_flux(:,:,:) = 0.0 m=1 do j=js,je ; do i=is,ie - !set tracer to 1.0 in the surface of the continental shelf - if (G%geoLonT(i,j) <= (CS%CSL)) then - CS%tr(i,j,1,m) = 1.0 !first layer - endif + ! set tracer to 1.0 in the surface of the continental shelf + if (G%geoLonT(i,j) <= (CS%CSL)) then + CS%tr(i,j,1,m) = 1.0 !first layer + endif enddo ; enddo if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 3aa65e8b3c..b4dd93e49e 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -170,7 +170,7 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS type(time_type), target, intent(in) :: day !< Time of the start of the run. 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -259,15 +259,15 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -288,9 +288,7 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -316,14 +314,15 @@ end subroutine advection_test_tracer_column_physics !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine advection_test_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. +subroutine advection_test_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_advection_test_tracer. + !! call to register_advection_test_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. @@ -350,10 +349,10 @@ end subroutine advection_test_tracer_surface_state !! If the stock_index is present, only the stock corresponding to that coded index is returned. function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index fc85b5c3ec..be7aa2b37e 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -154,7 +154,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, type(time_type), target, intent(in) :: day !< Time of the start of the run. 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -207,15 +207,15 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, tv, debug, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -245,7 +245,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, real :: year, h_total, scale, htot, Ih_limit integer :: secs, days integer :: i, j, k, is, ie, js, je, nz, m, k_max - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -285,7 +285,7 @@ end subroutine boundary_impulse_tracer_column_physics function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) 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] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -333,14 +333,15 @@ end function boundary_impulse_stock !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine boundary_impulse_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. +subroutine boundary_impulse_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_boundary_impulse_tracer. + !! call to register_boundary_impulse_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 8a970fa9ca..48baddaab9 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -247,15 +247,15 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -271,7 +271,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US !! fluxes can be applied [H ~> m or kg m-2] ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified real :: sfc_val ! The surface value for the tracers. real :: Isecs_per_year ! The number of seconds in a year. real :: year ! The time in years. @@ -372,14 +372,15 @@ end function dye_stock !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine dye_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. - type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_dye_tracer. +subroutine dye_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_dye_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 198ee1bc4f..c54396eee6 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -138,7 +138,7 @@ subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS) logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< Structure specifying open boundary options. type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -159,7 +159,6 @@ subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS) real, pointer :: tr_ptr(:,:,:) => NULL() real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: e(SZK_(G)+1), e_top, e_bot, d_tr integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -204,15 +203,15 @@ subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -228,9 +227,7 @@ subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, !! fluxes can be applied [H ~> m or kg m-2] ! Local variables - real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 8f00b0d5b9..6689cc5149 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -201,7 +201,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -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)//".") @@ -285,15 +285,15 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -314,7 +314,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified real :: sfc_val ! The surface value for the tracers. real :: Isecs_per_year ! The inverse of the amount of time in a year [T-1 ~> s-1] real :: year ! The time in years. @@ -373,11 +373,11 @@ end subroutine ideal_age_tracer_column_physics !! has calculated. If stock_index is present, only the stock corresponding to that coded index is found. function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -420,14 +420,15 @@ end function ideal_age_stock !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine ideal_age_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. - type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_ideal_age_tracer. +subroutine ideal_age_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_ideal_age_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index c07f1c03e4..ae2c71a87c 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -209,7 +209,7 @@ subroutine initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -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)//".") @@ -300,15 +300,15 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -331,7 +331,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] real :: Isecs_per_year = 1.0 / (365.0*86400.0) real :: year, h_total, ldecay integer :: i, j, k, is, ie, js, je, nz, m, k_max @@ -407,7 +407,7 @@ end subroutine oil_tracer_column_physics function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) 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] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -454,14 +454,15 @@ end function oil_stock !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine oil_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. - type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_oil_tracer. +subroutine oil_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_oil_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 11238fee89..df795d3119 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -119,7 +119,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, type(time_type), target, intent(in) :: day !< Time of the start of the run. 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -174,15 +174,15 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -209,7 +209,7 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G real :: year, h_total, scale, htot, Ih_limit integer :: secs, days integer :: i, j, k, is, ie, js, je, nz, k_max - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -252,7 +252,7 @@ end subroutine pseudo_salt_tracer_column_physics function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) 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] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -298,14 +298,15 @@ end function pseudo_salt_stock !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. !! This particular tracer package does not report anything back to the coupler. -subroutine pseudo_salt_tracer_surface_state(sfc_state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's 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 thickness [H ~> m or kg m-2]. - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. +subroutine pseudo_salt_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_(GV)), & + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. ! This particular tracer package does not report anything back to the coupler. ! The code that is here is just a rough guide for packages that would. diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index ef16cc985d..afb341ac16 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -143,7 +143,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(time_type), target, intent(in) :: day !< Time of the start of the run. 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -233,7 +233,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! This is needed to force the compiler not to do a copy in the sponge ! calls. Curses on the designers and implementers of Fortran90. tr_ptr => CS%tr(:,:,:,m) - call set_up_sponge_field(temp, tr_ptr, G, nz, sponge_CSp) + call set_up_sponge_field(temp, tr_ptr, G, GV, nz, sponge_CSp) enddo deallocate(temp) endif @@ -263,15 +263,15 @@ end subroutine USER_initialize_tracer subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -286,7 +286,7 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, real :: hold0(SZI_(G)) ! The original topmost layer thickness, ! with surface mass fluxes added back, m. real :: b1(SZI_(G)) ! b1 and c1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. + real :: c1(SZI_(G),SZK_(GV)) ! tridiagonal solver. real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -362,7 +362,7 @@ end subroutine tracer_column_physics function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) 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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. @@ -405,11 +405,12 @@ end function USER_tracer_stock !> This subroutine extracts the surface fields from this tracer package that !! are to be shared with the atmosphere in coupled configurations. -subroutine USER_tracer_surface_state(sfc_state, h, G, CS) +subroutine USER_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)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a previous !! call to register_USER_tracer. diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 5465d5fcea..f632b95086 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 @@ -128,7 +128,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para max_damping = 1.0 / (86400.0*US%s_to_T) - do i=is,ie; do j=js,je + do j=js,je ; do i=is,ie if (G%bathyT(i,j) <= min_depth) then ; Idamp(i,j) = 0.0 elseif (G%geoLatT(i,j) < slat+2.0) then ; Idamp(i,j) = max_damping elseif (G%geoLatT(i,j) < slat+4.0) then diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 923801db2d..293d601757 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 @@ -225,9 +225,9 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, 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] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -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 @@ -363,25 +363,27 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables - real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp [degC] - real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt [ppt] - real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness [H ~> m or kg m-2]. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness [Z ~> m] + real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [degC] + real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [ppt] + real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2]. + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m] real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. - real :: S_ref, T_ref ! Reference salinity and temerature within surface layer - real :: S_range, T_range ! Range of salinities and temperatures over the vertical - real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], + real :: S_ref ! Reference salinity within the surface layer [ppt] + real :: T_ref ! Reference temerature within the surface layer [degC] + real :: S_range ! Range of salinities in the vertical [ppt] + real :: T_range ! Range of temperatures in the vertical [degC] + real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], ! usually negative because it is positive upward. - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. - real :: d_eta(SZK_(G)) ! The layer thickness in a column [Z ~> m]. + real :: d_eta(SZK_(GV)) ! The layer thickness in a column [Z ~> m]. real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale ! Sponge timescales [T ~> s] real :: dome2d_west_sponge_width, dome2d_east_sponge_width real :: dummy1, x, z 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, & @@ -447,7 +449,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC ! Construct a grid (somewhat arbitrarily) to describe the sponge T/S on do k=1,nz - e0(k) = -G%max_depth * ( real(k-1) / real(nz) ) + e0(k) = -G%max_depth * ( real(k-1) / real(nz) ) enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie @@ -463,7 +465,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 @@ -479,10 +481,10 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC enddo ; enddo if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T, G, tv%T, ACSp) + call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S, G, tv%S, ACSp) + call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) endif else diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index f92d2d7ac6..9e749b8315 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 @@ -157,18 +157,18 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) type(sponge_CS), pointer :: CSp !< A pointer that is set to point to the control !! structure for this module. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta [Z ~> m]. - real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. + real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables. ! real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. - real :: H0(SZK_(G)) ! Interface heights [Z ~> m]. + real :: H0(SZK_(GV)) ! Interface heights [Z ~> m]. real :: min_depth ! The minimum depth at which to apply damping [Z ~> m] real :: damp, damp_new ! Damping rates in the sponge [days] real :: e_dense ! The depth of the densest interfaces [Z ~> m] 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 @@ -184,7 +184,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) H0(1) = 0.0 do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo - do i=is,ie; do j=js,je + do j=js,je ; do i=is,ie if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0 elseif (G%geoLonT(i,j) < 200.0) then damp = 10.0 * (200.0-G%geoLonT(i,j))/100.0 @@ -234,9 +234,9 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) call MOM_error(FATAL,"DOME_initialize_sponges is not set up for use with"//& " a temperatures defined.") ! This should use the target values of T in temp. - call set_up_sponge_field(temp, tv%T, G, nz, CSp) + call set_up_sponge_field(temp, tv%T, G, GV, nz, CSp) ! This should use the target values of S in temp. - call set_up_sponge_field(temp, tv%S, G, nz, CSp) + call set_up_sponge_field(temp, tv%S, G, GV, nz, CSp) endif end subroutine DOME_initialize_sponges @@ -260,11 +260,12 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! Local variables ! The following variables are used to set the target temperature and salinity. - real :: T0(SZK_(G)), S0(SZK_(G)) - real :: pres(SZK_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. + real :: T0(SZK_(GV)) ! A profile of temperatures [degC] + real :: S0(SZK_(GV)) ! A profile of salinities [ppt] + real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 real :: D_edge ! The thickness [Z ~> m], of the dense fluid at the @@ -281,7 +282,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 a0b8990e62..aa1c6cdfe6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -142,10 +142,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units [Z ~> m]. + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x real :: min_thickness, s_sur, s_bot, t_sur, t_bot @@ -155,7 +155,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 @@ -231,7 +231,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo - enddo ; enddo + enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. @@ -253,9 +253,9 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -275,15 +275,16 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi real :: rho_tmp logical :: just_read ! If true, just read parameters but set nothing. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. - real :: T0(SZK_(G)), S0(SZK_(G)) - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. - real :: pres(SZK_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. (zero here) + real :: T0(SZK_(GV)) ! A profile of temperatures [degC] + real :: S0(SZK_(GV)) ! A profile of salinities [ppt] + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. + real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. (zero here) real :: drho_dT1 ! A prescribed derivative of density with temperature [R 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 @@ -435,10 +436,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables - real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp [degC] - real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt [ppt] - ! real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO [R ~> kg m-3] - real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness [H ~> m or kg m-2] + real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp [degC] + real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt [ppt] + ! real :: RHO(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for RHO [R ~> kg m-3] + real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness [H ~> m or kg m-2] real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. real :: TNUDG ! Nudging time scale [T ~> s] real :: S_sur, T_sur ! Surface salinity and temerature in sponge @@ -448,10 +449,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) real :: rho_range ! The range of densities [R ~> kg m-3] real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. - real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], usually + real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m]. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta [Z ~> m]. + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m]. + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. real :: min_depth, dummy1, z real :: rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file @@ -460,7 +461,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", & @@ -506,7 +507,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! will automatically set up the sponges only where Idamp is positive ! and mask2dT is 1. - do i=is,ie; do j=js,je + do j=js,je ; do i=is,ie if (G%bathyT(i,j) <= min_depth) then Idamp(i,j) = 0.0 elseif (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then @@ -533,46 +534,46 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) select case ( coordinateMode(verticalCoordinate) ) - case ( REGRIDDING_RHO ) - ! Construct notional interface positions - e0(1) = 0. - do K=2,nz - e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range - e0(k) = min( 0., e0(k) ) ! Bound by surface - e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model - ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',& - ! G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) - ! call MOM_mesg(mesg,5) - enddo - e0(nz+1) = -G%max_depth - - ! Calculate thicknesses - do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) - do k=nz,1,-1 - eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H - else - h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) - endif - enddo - enddo ; enddo - - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates - do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) - do k=nz,1,-1 - eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + min_thickness)) then - eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness * GV%Z_to_H - else - h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) - endif - enddo - enddo ; enddo + case ( REGRIDDING_RHO ) + ! Construct notional interface positions + e0(1) = 0. + do K=2,nz + e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range + e0(k) = min( 0., e0(k) ) ! Bound by surface + e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model + ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',& + ! G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) + ! call MOM_mesg(mesg,5) + enddo + e0(nz+1) = -G%max_depth + + ! Calculate thicknesses + do j=js,je ; do i=is,ie + eta1D(nz+1) = -G%bathyT(i,j) + do k=nz,1,-1 + eta1D(k) = e0(k) + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H + else + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) + endif + enddo + enddo ; enddo + + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + do j=js,je ; do i=is,ie + eta1D(nz+1) = -G%bathyT(i,j) + do k=nz,1,-1 + eta1D(k) = -G%max_depth * real(k-1) / real(nz) + if (eta1D(k) < (eta1D(k+1) + min_thickness)) then + eta1D(k) = eta1D(k+1) + min_thickness + h(i,j,k) = min_thickness * GV%Z_to_H + else + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) + endif + enddo + enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie @@ -587,7 +588,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 @@ -614,10 +615,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! The remaining calls to set_up_sponge_field can be in any order. ! if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T, G, tv%T, ACSp) + call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S, G, tv%S, ACSp) + call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) endif else ! layer mode @@ -663,8 +664,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, PF, CSp, GV) ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + call set_up_sponge_field(T, tv%T, G, GV, nz, CSp) + call set_up_sponge_field(S, tv%S, G, GV, nz, CSp) endif diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 25e60d4895..adaee16d4e 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -238,9 +238,9 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) if (CS%relative_tau) then - REL_TAU_FAC = 1. + REL_TAU_FAC = 1. else - REL_TAU_FAC = 0. !Multiplied to 0 surface current + REL_TAU_FAC = 0. !Multiplied to 0 surface current endif !> Compute storm center location @@ -432,9 +432,9 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx ALPH = A0 - A1*cos(CS%hurr_translation_dir-Adir-P1) if ( (radius > 10.*CS%rad_max_wind) .and.& (radius < 15.*CS%rad_max_wind) ) then - ALPH = ALPH*(15.0 - radius/CS%rad_max_wind)/5. + ALPH = ALPH*(15.0 - radius/CS%rad_max_wind)/5. elseif (radius > 15.*CS%rad_max_wind) then - ALPH = 0.0 + ALPH = 0.0 endif ALPH = ALPH * CS%Deg2Rad @@ -545,12 +545,12 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C ! be maintained. Causes winds far from storm center to be a ! couple of m/s higher than the correct Holland prof. if (BR_Bench) then - rkm = rad/1000. - rB = (US%L_to_m*rkm)**B + rkm = rad/1000. + rB = (US%L_to_m*rkm)**B else - ! if not comparing to benchmark, then use correct Holland prof. - rkm = rad - rB = (US%L_to_m*rad)**B + ! if not comparing to benchmark, then use correct Holland prof. + rkm = rad + rB = (US%L_to_m*rad)**B endif !/ BR ! Calculate U10 in the interior (inside of 10x radius of maximum wind), @@ -561,11 +561,11 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C elseif (rad > 10.*CS%rad_max_wind .AND. rad < 12.*CS%rad_max_wind) then rad=(CS%rad_max_wind)*10. if (BR_Bench) then - rkm = rad/1000. - rB = (US%L_to_m*rkm)**B + rkm = rad/1000. + rB = (US%L_to_m*rkm)**B else - rkm = rad - rB = (US%L_to_m*rad)**B + rkm = rad + rB = (US%L_to_m*rad)**B endif U10 = ( sqrt( A*B*dP*exp(-A/rB)/(1.2*US%kg_m3_to_R*rB) + 0.25*(rkm*f_local)**2 ) - 0.5*rkm*f_local) & * (12. - rad/CS%rad_max_wind)/2. @@ -588,7 +588,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C ALPH = 0.0 endif ALPH = ALPH * Deg2Rad - !/BR + !/BR ! Prepare for wind calculation ! X_TS is component of translation speed added to wind vector ! due to background steering wind. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 227c814b3c..b93007647d 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -177,7 +177,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2]. type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the Kelvin example. @@ -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..3e078b135b 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -211,9 +211,8 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Dummy Check if (associated(CS)) then - call MOM_error(FATAL, "wave_interface_init called with an associated"//& - "control structure.") - return + call MOM_error(FATAL, "wave_interface_init called with an associated control structure.") + return endif PI=4.0*atan(1.0) @@ -327,9 +326,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) call get_param(param_file,mdl,"SURFBAND_STOKES_Y",CS%PrescribedSurfStkY, & "Y-direction surface Stokes drift for bands.",units='m/s', & default=0.0) - case default! No method provided - call MOM_error(FATAL,'Check WAVE_METHOD.') - end select + case default! No method provided + call MOM_error(FATAL,'Check WAVE_METHOD.') + end select case (DHH85_STRING)!Donelan et al., 1985 spectrum WaveMethod = DHH85 @@ -349,8 +348,8 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) default=.false.) case (LF17_STRING)!Li and Fox-Kemper 17 wind-sea Langmuir number WaveMethod = LF17 - case default - call MOM_error(FATAL,'Check WAVE_METHOD.') + case default + call MOM_error(FATAL,'Check WAVE_METHOD.') end select ! Langmuir number Options @@ -369,9 +368,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 +384,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 @@ -480,7 +479,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. @@ -502,7 +501,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 +514,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 +548,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 +591,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 +623,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 +641,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 +663,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. @@ -904,7 +903,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & real :: Dpt_LASL, ShearDirection, WaveDirection real :: LA_STKx, LA_STKy, LA_STK ! Stokes velocities in [m s-1] logical :: ContinueLoop, USE_MA - real, dimension(SZK_(G)) :: US_H, VS_H + real, dimension(SZK_(GV)) :: US_H, VS_H real, dimension(NumBands) :: StkBand_X, StkBand_Y integer :: KK, BB @@ -921,7 +920,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 +932,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 @@ -1222,11 +1221,11 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid real, intent(in) :: dt !< Time step of MOM6 [T ~> s] for explicit solver - real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: u !< Velocity i-component [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< Velocity j-component [m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. @@ -1238,7 +1237,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 +1247,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 +1256,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 +1266,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)) )) @@ -1290,11 +1289,11 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES, US) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid real, intent(in) :: Dt !< Time step of MOM6 [s] CHECK IF PASSING RIGHT TIMESTEP - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: u !< Velocity i-component [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< Velocity j-component [m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. @@ -1303,7 +1302,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 +1312,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..93a43e4a3e 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -252,9 +252,9 @@ subroutine Neverworld_initialize_thickness(h, G, GV, US, param_file, eqn_of_stat real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. - real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile [Z ~> m]. + real, dimension(SZK_(GV)) :: h_profile ! Vector of initial thickness profile [Z ~> m]. real :: e_interface ! Current interface position [Z ~> m]. real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. real :: pert_amp ! Amplitude of perturbations measured in Angstrom_H @@ -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..8f5c6d283e 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -46,9 +46,9 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces [Z ~> m] - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta [Z ~> m] - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] + real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces [Z ~> m] + real :: eta_im(SZJ_(G),SZK_(GV)+1) ! A temporary array for zonal-mean eta [Z ~> m] + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: jet_width ! The width of the zonal-mean jet [km] real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] real :: y_2 ! The y-position relative to the center of the domain [km] @@ -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 @@ -216,11 +216,11 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field [H ~> m or kg m-2]. ! Local variables - real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta [Z ~> m]. - real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. + real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces. + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. + real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta [Z ~> m]. + real :: eta_im(SZJ_(G),SZK_(GV)+1) ! A temporary array for zonal-mean eta [Z ~> m]. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate [T-1 ~> s-1]. real :: damp_rate ! The inverse zonal-mean damping rate [T-1 ~> s-1]. real :: jet_width ! The width of the zonal mean jet, in km. @@ -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 1600aca5bd..4df728c22a 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -47,17 +47,17 @@ 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. !! Absent fields have NULL ptrs. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & target, intent(in) :: u !< Array with the u velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & target, intent(in) :: v !< Array with the v velocity [L T-1 ~> m s-1] type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model @@ -67,20 +67,17 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables - real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp - real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt - real :: U1(SZIB_(G),SZJ_(G),SZK_(G)) ! A temporary array for u [L T-1 ~> m s-1] - real :: V1(SZI_(G),SZJB_(G),SZK_(G)) ! A temporary array for v [L T-1 ~> m s-1] - real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO + real :: T(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for temp + real :: S(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for salt + real :: U1(SZIB_(G),SZJ_(G),SZK_(GV)) ! A temporary array for u [L T-1 ~> m s-1] + real :: V1(SZI_(G),SZJB_(G),SZK_(GV)) ! A temporary array for v [L T-1 ~> m s-1] + real :: RHO(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for RHO real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. - real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness at h points + real :: h(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for thickness at h points real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points [T-1 ~> s-1]. real :: TNUDG ! Nudging time scale [T ~> s] real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa] - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. - ! positive upward, in m. + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for eta, positive upward [m]. logical :: sponge_uv ! Nudge velocities (u and v) towards zero real :: min_depth, dummy1, z, delta_h real :: rho_dummy, min_thickness, rho_tmp, xi0 @@ -92,7 +89,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 @@ -174,26 +171,20 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) - if (use_ALE) then call MOM_read_data(filename, h_var, h(:,:,:), G%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 - call set_up_ALE_sponge_field(T,G,tv%T,ACSp) - endif - if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S,G,tv%S,ACSp) - endif + if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) + if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) if (sponge_uv) then - U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 - call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) + U1(:,:,:) = 0.0 ; V1(:,:,:) = 0.0 + call set_up_ALE_sponge_vel_field(U1, V1, G, GV, u, v, ACSp) endif @@ -220,8 +211,8 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) endif ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + call set_up_sponge_field(T, tv%T, G, GV, nz, CSp) + call set_up_sponge_field(S, tv%S, G, GV, nz, CSp) endif diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 1238944a60..cd87b47621 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 @@ -113,9 +113,9 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & param_file, eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file handle type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -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 @@ -165,11 +165,11 @@ end subroutine Rossby_front_initialize_temperature_salinity subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) 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)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -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..ad4eab33ff 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -43,10 +43,10 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], usually - ! negative because it is positive upward. - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units [Z ~> m]. + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], usually + ! negative because it is positive upward. + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units [Z ~> m]. real :: dRho_dS ! The partial derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. ! In this subroutine it is hard coded at 1.0 kg m-3 ppt-1. real :: x, y, yy @@ -54,14 +54,14 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read real :: min_thickness, adjustment_width, adjustment_delta real :: adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym - real :: target_values(SZK_(G)+1) ! Target densities or density anomalies [R ~> kg m-3] + real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate ! This include declares and sets the variable "version". #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 @@ -197,9 +197,9 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file eqn_of_state, 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 temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [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. type(EOS_type), pointer :: eqn_of_state !< Equation of state. @@ -216,11 +216,11 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file real :: xi0, xi1, dSdz, delta_S, delta_S_strat real :: adjustment_width, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym - real :: eta1d(SZK_(G)+1) + real :: eta1d(SZK_(GV)+1) 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..b1c988e016 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -80,9 +80,9 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f 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 - 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] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file handle logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. @@ -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..ed0bbbf069 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, "") @@ -216,11 +216,11 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & eqn_of_state, P_Ref, 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. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being - !! initialized. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature + !! that is being initialized [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being + !! initialized [ppt] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for !! model parameter values. @@ -230,11 +230,12 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: T0(SZK_(G)), S0(SZK_(G)) - real :: pres(SZK_(G)) ! Reference pressure [R L2 T-2 ~> Pa]. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [R ~> kg m-3]. + real :: T0(SZK_(GV)) ! A profile of temperatures [degC] + real :: S0(SZK_(GV)) ! A profile of salinities [ppt] + real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa]. + real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R degC-1 ~> kg m-3 degC-1]. + real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R ppt-1 ~> kg m-3 ppt-1]. + real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: SST ! The initial sea surface temperature [degC]. real :: lat @@ -242,7 +243,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..e8fe345bb0 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 @@ -278,8 +278,8 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CS enddo enddo - if (associated(tv%T)) call set_up_ALE_sponge_field(T, G, tv%T, ACSp) - if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, tv%S, ACSp) + if (associated(tv%T)) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) + if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) else call MOM_error(FATAL, "dense_water_initialize_sponges: trying to use non ALE sponge") endif diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 2b2b8b46c6..f7b647dd27 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -101,9 +101,9 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], usually + real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities [ppt]. @@ -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 @@ -211,9 +211,9 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, 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 !< 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] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -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 @@ -393,7 +393,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, enddo ; enddo endif - if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, tv%S, ACSp) + if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) end subroutine dumbbell_initialize_sponges 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..9da82cb721 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -36,10 +36,10 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward [Z ~> m]. - real :: ssh_anomaly_height ! Vertical height of ssh anomaly - real :: ssh_anomaly_width ! Lateral width of anomaly + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward [Z ~> m]. + real :: ssh_anomaly_height ! Vertical height of ssh anomaly [Z ~> m] + real :: ssh_anomaly_width ! Lateral width of anomaly [degrees] logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "external_gwave_initialize_thickness" ! This subroutine's name. ! This include declares and sets the variable "version". @@ -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..9118133108 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -88,10 +88,9 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], usually + real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward [Z ~> m]. + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities [ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. @@ -99,7 +98,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 @@ -195,9 +194,9 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, 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 !< 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] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -210,7 +209,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..7bf6aebf59 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. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness. - type(time_type), intent(in) :: Time !< model time. + 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_(GV)), intent(in) :: h !< layer thickness. + 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..e1c0a96d63 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -64,10 +64,10 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: displ(SZK_(G)+1) ! The interface displacement in depth units. - real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights [nondim]. - real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. - real :: a0 ! The displacement amplitude in depth units. + real :: displ(SZK_(GV)+1) ! The interface displacement [Z ~> m]. + real :: z_unif(SZK_(GV)+1) ! Fractional uniform interface heights [nondim]. + real :: z_inter(SZK_(GV)+1) ! Interface heights [Z ~> m] + real :: a0 ! The displacement amplitude [Z ~> m]. real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. real :: x1, y1, x2, y2 ! Dimensonless parameters. real :: x, t ! Dimensionless depth coordinates? @@ -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, "") @@ -180,9 +180,9 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, 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]. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -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..ac6ec8c4bc 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,12 +63,13 @@ 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) - type(ocean_grid_type), intent(in) :: G !< 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] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type +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_(GV)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: x, x0 ! Positions in the same units as geoLonT. @@ -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..e6db433f60 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. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness. - type(time_type), intent(in) :: Time !< model time. +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_(GV)), intent(in) :: h !< layer thickness. + 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..92570e3caa 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -47,25 +47,25 @@ module user_change_diffusivity subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) 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 [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(user_change_diff_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of !! each layer [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity !! at each interface [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: S_f !< Salinity with massless !! layers filled in vertically [ppt]. - real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal + real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at !! each interface [Z2 T-1 ~> m2 s-1]. ! Local variables - real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers [R ~> kg m-3]. + real :: Rcv(SZI_(G),SZK_(GV)) ! The coordinate density in layers [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures [R L2 T-2 ~> Pa]. real :: rho_fn ! The density dependence of the input function, 0-1 [nondim]. real :: lat_fn ! The latitude dependence of the input function, 0-1 [nondim]. @@ -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..793b87f149 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -105,10 +105,11 @@ 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. - 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(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G), SZJB_(G),SZK_(GV)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model @@ -135,10 +136,11 @@ 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. - 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(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -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.