From 43d4f16b63551d01be6725dccfc525da0b5d3941 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 1 Oct 2021 19:49:43 -0400 Subject: [PATCH 001/138] (+*)Fix MEKE advection bug Added the new runtime option MEKE_ADVECTION_BUG and corrected a bug in the calculation of the vertically integrated transport for the advection of the MEKE field when MEKE_ADVECTION_FACTOR > 0. The default is to fix the bug, so answers can change in some cases by default, and in those cases there are changes to the MOM_parameter_doc files, but this option is not widely used and there are no answer changes in the MOM6-examples test suite. This PR addresses MOM6 issue #1465, which can be closed once this PR is merged into dev/gfdl. --- src/parameterizations/lateral/MOM_MEKE.F90 | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 5efb318db1..633058afd7 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -82,6 +82,9 @@ module MOM_MEKE real :: MEKE_topographic_beta !< Weight for how much topographic beta is considered !! when computing beta in Rhines scale [nondim] real :: MEKE_restoring_rate !< Inverse of the timescale used to nudge MEKE toward its equilibrium value [s-1]. + logical :: MEKE_advection_bug !< If true, recover a bug in the calculation of the barotropic + !! transport for the advection of MEKE, wherein only the transports in the + !! deepest layer are used. logical :: fixed_total_depth !< If true, use the nominal bathymetric depth as the estimate of !! the time-varying ocean depth. Otherwise base the depth on the total !! ocean mass per unit area. @@ -220,7 +223,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do j=js,je ; do I=is-1,ie - baroHu(I,j) = hu(I,j,k) * GV%H_to_RZ + baroHu(I,j) = baroHu(I,j) + hu(I,j,k) * GV%H_to_RZ enddo ; enddo enddo do J=js-1,je ; do i=is,ie @@ -228,9 +231,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do J=js-1,je ; do i=is,ie - baroHv(i,J) = hv(i,J,k) * GV%H_to_RZ + baroHv(i,J) = baroHv(i,J) + hv(i,J,k) * GV%H_to_RZ enddo ; enddo enddo + if (CS%MEKE_advection_bug) then + ! This code obviously incorrect code reproduces a bug in the original implementation of + ! the MEKE advection. + do j=js,je ; do I=is-1,ie + baroHu(I,j) = hu(I,j,nz) * GV%H_to_RZ + enddo ; enddo + do J=js-1,je ; do i=is,ie + baroHv(i,J) = hv(i,J,nz) * GV%H_to_RZ + enddo ; enddo + endif endif @@ -1212,6 +1225,10 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "Using unity would be normal but other values could accommodate a mismatch "//& "between the advecting barotropic flow and the vertical structure of MEKE.", & units="nondim", default=0.0) + call get_param(param_file, mdl, "MEKE_ADVECTION_BUG", CS%MEKE_advection_bug, & + "If true, recover a bug in the calculation of the barotropic transport for "//& + "the advection of MEKE. With the bug, only the transports in the deepest "//& + "layer are used.", default=.false., do_not_log=(CS%MEKE_advection_factor<=0.)) call get_param(param_file, mdl, "MEKE_TOPOGRAPHIC_BETA", CS%MEKE_topographic_beta, & "A scale factor to determine how much topographic beta is weighed in " //& "computing beta in the expression of Rhines scale. Use 1 if full "//& From 374acc55e5046a99aa385d230178c2135a2f12a4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 5 Oct 2021 14:48:49 -0400 Subject: [PATCH 002/138] +Add BAROTROPIC_TIDAL_SAL_BUG to fix a tide bug Added a runtime flag, BAROTROPIC_TIDAL_SAL_BUG, to fix a sign error in the tidal self-attraction and loading anomalies in the barotropic solver when tides are enabled. The default is to keep the previous bug so that answers do not change, but this default will be changed after solutions have been corrected. This commit partly addresses MOM6 issue #1496, but it should only be considered to be properly handled once the default has been changed to avoid this bug. This commit will change the MOM_parameter_doc files in cases where this bug matters, but by default all answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index abc2e228f6..f912ff3275 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -225,6 +225,9 @@ module MOM_barotropic !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. + logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the + !! barotropic solver has the wrong sign, replicating a long-standing + !! bug. real :: G_extra !< A nondimensional factor by which gtot is enhanced. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are @@ -1048,7 +1051,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%tides) then call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + det_de + CS%G_extra + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + det_de + CS%G_extra + else + dgeo_de = (1.0 - det_de) + CS%G_extra + endif else dgeo_de = 1.0 + CS%G_extra endif @@ -2792,7 +2799,11 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) det_de = 0.0 if (CS%tides) call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + else + dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de) + endif if (present(pbce)) then do j=js,je ; do i=is,ie gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0 @@ -4329,6 +4340,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! a restart file to the internal representation in this run. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. + real :: det_de ! The partial derivative due to self-attraction and loading of the reference + ! geopotential with the sea surface height when tides are enabled. + ! This is typically ~0.09 or less. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -4483,6 +4497,14 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) + det_de = 0.0 + if (CS%tides .and. associated(CS%tides_CSp)) & + call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) + call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, & + "If true, the tidal self-attraction and loading anomaly in the barotropic "//& + "solver has the wrong sign, replicating a long-standing bug with a scalar "//& + "self-attraction and loading term or the SAL term from a previous simulation.", & + default=.true., do_not_log=(det_de==0.0)) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the "//& "Sadourny (1975) energy conserving scheme, otherwise "//& From 5c3f14368c95c235789b8a52d5f32ed69d91cc7c Mon Sep 17 00:00:00 2001 From: Spencer Jones <41342785+cspencerjones@users.noreply.github.com> Date: Mon, 11 Oct 2021 18:12:45 -0500 Subject: [PATCH 003/138] Particle API (#1504) * first draft API based on Luyu's code * fixed various errors * Code for particles in MOM.F90 * moved particles_run into dynamics step * added particles_end * Fixed particle time * Fixed some documentation * Further documentation edits * converted pointers to allocatables in particles_gridded * Remove trailing space * Further doxygen tweaks * another trailing space * removed set_time Co-authored-by: Cory Spencer Jones --- .../external/drifters/MOM_particles.F90 | 59 +++++++ .../external/drifters/MOM_particles_types.F90 | 161 ++++++++++++++++++ src/core/MOM.F90 | 28 +++ 3 files changed, 248 insertions(+) create mode 100644 config_src/external/drifters/MOM_particles.F90 create mode 100644 config_src/external/drifters/MOM_particles_types.F90 diff --git a/config_src/external/drifters/MOM_particles.F90 b/config_src/external/drifters/MOM_particles.F90 new file mode 100644 index 0000000000..135f5d284c --- /dev/null +++ b/config_src/external/drifters/MOM_particles.F90 @@ -0,0 +1,59 @@ +!> A set of dummy interfaces for compiling the MOM6 drifters code +module MOM_particles_mod + +use MOM_grid, only : ocean_grid_type +use MOM_time_manager, only : time_type, get_date, operator(-) +use MOM_variables, only : thermo_var_ptrs + + +use particles_types_mod, only: particles, particles_gridded + +public particles_run, particles_init, particles_save_restart, particles_end + +contains + +!> Initializes particles container "parts" +subroutine particles_init(parts, Grid, Time, dt, u, v) + ! Arguments + type(particles), pointer, intent(out) :: parts !< Container for all types and memory + type(ocean_grid_type), target, intent(in) :: Grid !< Grid type from parent model + type(time_type), intent(in) :: Time !< Time type from parent model + real, intent(in) :: dt !< particle timestep in seconds + real, dimension(:,:,:),intent(in) :: u !< Zonal velocity field + real, dimension(:,:,:),intent(in) :: v !< Meridional velocity field + +end subroutine particles_init + +!> The main driver the steps updates particles +subroutine particles_run(parts, time, uo, vo, ho, tv, stagger) + ! Arguments + type(particles), pointer :: parts !< Container for all types and memory + type(time_type), intent(in) :: time !< Model time + real, dimension(:,:,:),intent(in) :: uo !< Ocean zonal velocity (m/s) + real, dimension(:,:,:),intent(in) :: vo !< Ocean meridional velocity (m/s) + real, dimension(:,:,:),intent(in) :: ho !< Ocean layer thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< structure containing pointers to available thermodynamic fields + integer, optional, intent(in) :: stagger !< Flag for whether velocities are staggered + +end subroutine particles_run + + +!>Save particle locations (and sometimes other vars) to restart file +subroutine particles_save_restart(parts,temp,salt) +! Arguments +type(particles), pointer :: parts !< Container for all types and memory +real,dimension(:,:,:),optional,intent(in) :: temp !< Optional container for temperature +real,dimension(:,:,:),optional,intent(in) :: salt !< Optional container for salinity + +end subroutine particles_save_restart + +!> Deallocate all memory and disassociated pointer +subroutine particles_end(parts,temp,salt) +! Arguments +type(particles), pointer :: parts !< Container for all types and memory +real,dimension(:,:,:),optional,intent(in) :: temp !< Optional container for temperature +real,dimension(:,:,:),optional,intent(in) :: salt !< Optional container for salinity + +end subroutine particles_end + +end module MOM_particles_mod diff --git a/config_src/external/drifters/MOM_particles_types.F90 b/config_src/external/drifters/MOM_particles_types.F90 new file mode 100644 index 0000000000..b7bc01acb9 --- /dev/null +++ b/config_src/external/drifters/MOM_particles_types.F90 @@ -0,0 +1,161 @@ +!> Dummy data structures and methods for drifters package +module particles_types_mod + +use MOM_grid, only : ocean_grid_type +use mpp_domains_mod, only: domain2D + + +!> Container for gridded fields +type :: particles_gridded + type(domain2D), pointer :: domain !< MPP parallel domain + integer :: halo !< Nominal halo width + integer :: isc !< Start i-index of computational domain + integer :: iec !< End i-index of computational domain + integer :: jsc !< Start j-index of computational domain + integer :: jec !< End j-index of computational domain + integer :: isd !< Start i-index of data domain + integer :: ied !< End i-index of data domain + integer :: jsd !< Start j-index of data domain + integer :: jed !< End j-index of data domain + integer :: isg !< Start i-index of global domain + integer :: ieg !< End i-index of global domain + integer :: jsg !< Start j-index of global domain + integer :: jeg !< End j-index of global domain + integer :: is_offset=0 !< add to i to recover global i-index + integer :: js_offset=0 !< add to j to recover global j-index + integer :: my_pe !< MPI PE index + integer :: pe_N !< MPI PE index of PE to the north + integer :: pe_S !< MPI PE index of PE to the south + integer :: pe_E !< MPI PE index of PE to the east + integer :: pe_W !< MPI PE index of PE to the west + logical :: grid_is_latlon !< Flag to say whether the coordinate is in lat-lon degrees, or meters + logical :: grid_is_regular !< Flag to say whether point in cell can be found assuming regular Cartesian grid + real :: Lx !< Length of the domain in x direction + real, dimension(:,:), allocatable :: lon !< Longitude of cell corners (degree E) + real, dimension(:,:), allocatable :: lat !< Latitude of cell corners (degree N) + real, dimension(:,:), allocatable :: lonc !< Longitude of cell centers (degree E) + real, dimension(:,:), allocatable :: latc !< Latitude of cell centers (degree N) + real, dimension(:,:), allocatable :: dx !< Length of cell edge (m) + real, dimension(:,:), allocatable :: dy !< Length of cell edge (m) + real, dimension(:,:), allocatable :: area !< Area of cell (m^2) + real, dimension(:,:), allocatable :: msk !< Ocean-land mask (1=ocean) + real, dimension(:,:), allocatable :: cos !< Cosine from rotation matrix to lat-lon coords + real, dimension(:,:), allocatable :: sin !< Sine from rotation matrix to lat-lon coords + real, dimension(:,:), allocatable :: ocean_depth !< Depth of ocean (m) + real, dimension(:,:), allocatable :: uo !< Ocean zonal flow (m/s) + real, dimension(:,:), allocatable :: vo !< Ocean meridional flow (m/s) + real, dimension(:,:), allocatable :: tmp !< Temporary work space + real, dimension(:,:), allocatable :: tmpc !< Temporary work space + real, dimension(:,:), allocatable :: parity_x !< X component of vector point from i,j to i+1,j+1 + real, dimension(:,:), allocatable :: parity_y !< Y component of vector point from i,j to i+1,j+1 + ! (For detecting tri-polar fold) + integer, dimension(:,:), allocatable :: particle_counter_grd !< Counts particles created for naming purposes + !>@{ + !! Diagnostic handle + integer :: id_uo=-1, id_vo=-1, id_unused=-1 + integer :: id_count=-1, id_chksum=-1 + !>@} + +end type particles_gridded + + +!>xyt is a data structure containing particle position and velocity fields. +type :: xyt + real :: lon !< Longitude of particle (degree N or unit of grid coordinate) + real :: lat !< Latitude of particle (degree N or unit of grid coordinate) + real :: day !< Day of this record (days) + real :: lat_old !< Previous latitude + real :: lon_old !< Previous longitude + real :: uvel !< Zonal velocity of particle (m/s) + real :: vvel !< Meridional velocity of particle (m/s) + real :: uvel_old !< Previous zonal velocity component (m/s) + real :: vvel_old !< Previous meridional velocity component (m/s) + integer :: year !< Year of this record + integer :: particle_num !< Current particle number + integer(kind=8) :: id = -1 !< Particle Identifier + type(xyt), pointer :: next=>null() !< Pointer to the next position in the list +end type xyt + +!>particle types are data structures describing a tracked particle +type :: particle + type(particle), pointer :: prev=>null() !< Previous link in list + type(particle), pointer :: next=>null() !< Next link in list +! State variables (specific to the particles, needed for restarts) + real :: lon !< Longitude of particle (degree N or unit of grid coordinate) + real :: lat !< Latitude of particle (degree E or unit of grid coordinate) + real :: depth !< Depth of particle + real :: uvel !< Zonal velocity of particle (m/s) + real :: vvel !< Meridional velocity of particle (m/s) + real :: lon_old !< previous lon (degrees) + real :: lat_old !< previous lat (degrees) + real :: uvel_old !< previous uvel + real :: vvel_old !< previous vvel + real :: start_lon !< starting longitude where particle was created + real :: start_lat !< starting latitude where particle was created + real :: start_day !< origination position (degrees) and day + integer :: start_year !< origination year + real :: halo_part !< equal to zero for particles on the computational domain, and 1 for particles on the halo + integer(kind=8) :: id !< particle identifier + integer(kind=8) :: drifter_num !< particle identifier + integer :: ine !< nearest i-index in NE direction (for convenience) + integer :: jne !< nearest j-index in NE direction (for convenience) + real :: xi !< non-dimensional x-coordinate within current cell (0..1) + real :: yj !< non-dimensional y-coordinate within current cell (0..1) + real :: uo !< zonal ocean velocity + real :: vo !< meridional ocean velocity + !< by the particle (m/s) + type(xyt), pointer :: trajectory=>null() !< Trajectory for this particle +end type particle + + +!>A buffer structure for message passing +type :: buffer + integer :: size=0 !< Size of buffer + real, dimension(:,:), pointer :: data !< Buffer memory +end type buffer + +!> A wrapper for the particle linked list (since an array of pointers is not allowed) +type :: linked_list + type(particle), pointer :: first=>null() !< Pointer to the beginning of a linked list of parts +end type linked_list + + +!> A grand data structure for the particles in the local MOM domain +type :: particles !; private + type(particles_gridded) :: grd !< Container with all gridded data + type(linked_list), dimension(:,:), allocatable :: list !< Linked list of particles + type(xyt), pointer :: trajectories=>null() !< A linked list for detached segments of trajectories + real :: dt !< Time-step between particle calls + integer :: current_year !< Current year (years) + real :: current_yearday !< Current year-day, 1.00-365.99, (days) + integer :: traj_sample_hrs !< Period between sampling for trajectories (hours) + integer :: traj_write_hrs !< Period between writing of trajectories (hours) + integer :: verbose_hrs !< Period between terminal status reports (hours) + !>@{ + !! Handles for clocks + integer :: clock, clock_mom, clock_the, clock_int, clock_cal, clock_com, clock_ini, clock_ior, clock_iow, clock_dia + integer :: clock_trw, clock_trp + !>@} + logical :: restarted=.false. !< Indicate whether we read state from a restart or not + logical :: Runge_not_Verlet=.True. !< True=Runge-Kutta, False=Verlet. + logical :: ignore_missing_restart_parts=.False. !< True allows the model to ignore particles missing in the restart. + logical :: halo_debugging=.False. !< Use for debugging halos (remove when its working) + logical :: save_short_traj=.false. !< True saves only lon,lat,time,id in particle_trajectory.nc + logical :: ignore_traj=.False. !< If true, then model does not write trajectory data at all + logical :: use_new_predictive_corrective =.False. !< Flag to use Bob's predictive corrective particle scheme + !Added by Alon + integer(kind=8) :: debug_particle_with_id = -1 !< If positive, monitors a part with this id + type(buffer), pointer :: obuffer_n=>null() !< Buffer for outgoing parts to the north + type(buffer), pointer :: ibuffer_n=>null() !< Buffer for incoming parts from the north + type(buffer), pointer :: obuffer_s=>null() !< Buffer for outgoing parts to the south + type(buffer), pointer :: ibuffer_s=>null() !< Buffer for incoming parts from the south + type(buffer), pointer :: obuffer_e=>null() !< Buffer for outgoing parts to the east + type(buffer), pointer :: ibuffer_e=>null() !< Buffer for incoming parts from the east + type(buffer), pointer :: obuffer_w=>null() !< Buffer for outgoing parts to the west + type(buffer), pointer :: ibuffer_w=>null() !< Buffer for incoming parts from the west + type(buffer), pointer :: obuffer_io=>null() !< Buffer for outgoing parts during i/o + type(buffer), pointer :: ibuffer_io=>null() !< Buffer for incoming parts during i/o +end type particles + + +end module particles_types_mod diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1f1492f2e5..73a7cd58a7 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -150,6 +150,7 @@ module MOM use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf +use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end implicit none ; private @@ -329,6 +330,8 @@ module MOM logical :: answers_2018 !< If true, use expressions for the surface properties that recover !! the answers from the end of 2018. Otherwise, use more appropriate !! expressions that differ at roundoff for non-Boussinsq cases. + logical :: use_particles !< Turns on the particles package + character(len=10) :: particle_type !< Particle types include: surface(default), profiling and sail drone. type(MOM_diag_IDs) :: IDs !< Handles used for diagnostics. type(transport_diag_IDs) :: transport_IDs !< Handles used for transport diagnostics. @@ -396,6 +399,7 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors + type(particles), pointer :: particles => NULL() ! Date: Wed, 13 Oct 2021 01:07:09 +1100 Subject: [PATCH 004/138] adds missing _ (#1519) --- docs/about.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/about.rst b/docs/about.rst index 27c92b20fd..984e5776e8 100644 --- a/docs/about.rst +++ b/docs/about.rst @@ -8,7 +8,7 @@ Here is where to find particular documentation: Download, compile and run Installation documentation is in the form of user-driven (editable) wiki attached to the MOM6-examples GitHub repository. - Goto https://github.com/NOAA-GFDL/MOM6-examples/wiki and look at "Getting Started". + Go to https://github.com/NOAA-GFDL/MOM6-examples/wiki and look at "Getting Started". Installation, compilation and running are platform specific operations for which we can only provide templates (as is done in on the wiki) but for which MOM6 developers cannot possibly support since every platform is different. Normally @@ -31,4 +31,4 @@ Repository policies Policies governing how the repositories are organized and operated live at https://github.com/NOAA-GFDL/MOM6-examples/wiki/MOM6-repository-policies. Developer guide - Beyond the API reference above, developer specific wiki pages are attached to the `MOM6 code repository `. + Beyond the API reference above, developer specific wiki pages are attached to the `MOM6 code repository `_. From b08efb862b55178531b711ded1b18bb84e8dea99 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 4 Oct 2021 10:57:33 -0800 Subject: [PATCH 005/138] Working on boundary layer docs. --- docs/parameterizations_vertical.rst | 4 + docs/zotero.bib | 54 +++++++++++++ .../vertical/MOM_bulk_mixed_layer.F90 | 49 +++--------- .../vertical/MOM_energetic_PBL.F90 | 8 +- src/parameterizations/vertical/_BML.dox | 49 ++++++++++++ src/parameterizations/vertical/_EPBL.dox | 76 +++++++++++++++++++ 6 files changed, 197 insertions(+), 43 deletions(-) create mode 100644 src/parameterizations/vertical/_BML.dox create mode 100644 src/parameterizations/vertical/_EPBL.dox diff --git a/docs/parameterizations_vertical.rst b/docs/parameterizations_vertical.rst index 4705cf6c48..ff0784b698 100644 --- a/docs/parameterizations_vertical.rst +++ b/docs/parameterizations_vertical.rst @@ -14,9 +14,13 @@ K-profile parameterization (KPP) Energetic Planetary Boundary Layer (ePBL) A energetically constrained boundary layer scheme following :cite:`reichl2018`. Implemented in MOM_energetic_PBL. + :ref:`EPBL` + Bulk mixed layer (BML) A 2-layer bulk mixed layer used in pure-isopycnal model. Implemented in MOM_bulk_mixed_layer. + :ref:`BML` + Interior and bottom-driven mixing --------------------------------- diff --git a/docs/zotero.bib b/docs/zotero.bib index bb400542b8..c0c7ee3bd9 100644 --- a/docs/zotero.bib +++ b/docs/zotero.bib @@ -2684,3 +2684,57 @@ @techreport{griffies2015a pages = {98 pp}, institution = {NOAA GFDL} } + +@inbook{niiler1977, + author = {P. P. Niiler and E. B. Kraus}, + chapter = {One-dimesional models of the upper ocean}, + title = {Modelling and Prediction of the Upper Layers of the Ocean}, + year = {1977}, + editor = {E. B. Kraus}, + publisher = {Pergamon Press} +} + +@article{oberhuber1993, + doi = {10.1175/1520-0485(1993)023<0830:sotacw>2.0.co;2}, + year = 1993, + publisher = {American Meteorological Society}, + volume = {23}, + number = {5}, + pages = {830--845}, + author = {J. M. Oberhuber}, + title = {Simulation of the Atlantic Circulation with a Coupled Sea Ice-Mixed Layer-Isopycnal General Circulation Model. Part {II}: Model Experiment}, + journal = {J. Phys. Oceanography} +} + +@techreport{muller2003, + doi = {10.21236/ada618366}, + year = 2003, + publisher = {Defense Technical Information Center}, + author = {P. Muller}, + institution = {School of Ocean and Earth Science and Technology}, + title = {A{\textquotesingle}ha Huliko{\textquotesingle}a Workshop Series} +} + +@article{wang2003, + doi = {10.1029/2003gl017869}, + year = 2003, + publisher = {American Geophysical Union ({AGU})}, + volume = {30}, + number = {18}, + author = {D. Wang}, + title = {Entrainment laws and a bulk mixed layer model of rotating convection derived from large-eddy simulations}, + journal = {Geophys. Res. Lett.} +} + +@article{kraus1967, + doi = {10.3402/tellusa.v19i1.9753}, + year = 1967, + publisher = {Informa {UK} Limited}, + volume = {19}, + number = {1}, + pages = {98--106}, + author = {E. B. Kraus and J. S. Turner}, + title = {A one-dimensional model of the seasonal thermocline {II}. The general theory and its consequences}, + journal = {Tellus} +} + diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 4a9d428807..137294eda1 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -155,36 +155,8 @@ module MOM_bulk_mixed_layer contains -!> This subroutine partially steps the bulk mixed layer model. -!! The following processes are executed, in the order listed. -!! 1. Undergo convective adjustment into mixed layer. -!! 2. Apply surface heating and cooling. -!! 3. Starting from the top, entrain whatever fluid the TKE budget -!! permits. Penetrating shortwave radiation is also applied at -!! this point. -!! 4. If there is any unentrained fluid that was formerly in the -!! mixed layer, detrain this fluid into the buffer layer. This -!! is equivalent to the mixed layer detraining to the Monin- -!! Obukhov depth. -!! 5. Divide the fluid in the mixed layer evenly into CS%nkml pieces. -!! 6. Split the buffer layer if appropriate. -!! Layers 1 to nkml are the mixed layer, nkml+1 to nkml+nkbl are the -!! buffer layers. The results of this subroutine are mathematically -!! identical if there are multiple pieces of the mixed layer with -!! the same density or if there is just a single layer. There is no -!! stability limit on the time step. -!! -!! The key parameters for the mixed layer are found in the control structure. -!! These include mstar, nstar, nstar2, pen_SW_frac, pen_SW_scale, and TKE_decay. -!! For the Oberhuber (1993) mixed layer, the values of these are: -!! pen_SW_frac = 0.42, pen_SW_scale = 15.0 m, mstar = 1.25, -!! nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 -!! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. -!! Conv_decay has been eliminated in favor of the well-calibrated form for the -!! efficiency of penetrating convection from Wang (2003). -!! For a traditional Kraus-Turner mixed layer, the values are: -!! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, -!! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 +!> This subroutine partially steps the bulk mixed layer model. +!! See \ref BML for more details. subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, CS, & optics, Hml, aggregate_FW_forcing, dt_diag, last_call) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -3708,16 +3680,15 @@ end function EF4 !! !! This file contains the subroutine (bulkmixedlayer) that !! implements a Kraus-Turner-like bulk mixed layer, based on the work -!! of various people, as described in the review paper by Niiler and -!! Kraus (1979), with particular attention to the form proposed by -!! Oberhuber (JPO, 1993, 808-829), with an extension to a refied bulk -!! mixed layer as described in Hallberg (Aha Huliko'a, 2003). The -!! physical processes portrayed in this subroutine include convective -!! adjustment and mixed layer entrainment and detrainment. -!! Penetrating shortwave radiation and an exponential decay of TKE -!! fluxes are also supported by this subroutine. Several constants +!! of various people, as described in the review paper by \cite Niiler1977, +!! with particular attention to the form proposed by \cite Oberhuber1993, +!! with an extension to a refined bulk mixed layer as described in +!! Hallberg (\cite muller2003). The physical processes portrayed in +!! this subroutine include convective adjustment and mixed layer entrainment +!! and detrainment. Penetrating shortwave radiation and an exponential decay +!! of TKE fluxes are also supported by this subroutine. Several constants !! can alternately be set to give a traditional Kraus-Turner mixed !! layer scheme, although that is not the preferred option. The -!! physical processes and arguments are described in detail below. +!! physical processes and arguments are described in detail in \ref BML. end module MOM_bulk_mixed_layer diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5a9e67bfd9..c0e5207e4e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2468,10 +2468,10 @@ end subroutine energetic_PBL_end !! simple enough that it requires only a single vertical pass to !! determine the diffusivity. The development of bulk mixed layer !! models stems from the work of various people, as described in the -!! review paper by Niiler and Kraus (1979). The work here draws in -!! with particular on the form for TKE decay proposed by Oberhuber -!! (JPO, 1993, 808-829), with an extension to a refined bulk mixed -!! layer as described in Hallberg (Aha Huliko'a, 2003). The physical +!! review paper by \cite niiler1977. The work here draws in +!! with particular on the form for TKE decay proposed by +!! \cite oberhuber1993, with an extension to a refined bulk mixed +!! layer as described in Hallberg (\cite muller2003). The physical !! processes portrayed in this subroutine include convectively driven !! mixing and mechanically driven mixing. Unlike boundary-layer !! mixing, stratified shear mixing is not a one-directional turbulent diff --git a/src/parameterizations/vertical/_BML.dox b/src/parameterizations/vertical/_BML.dox new file mode 100644 index 0000000000..2786a26851 --- /dev/null +++ b/src/parameterizations/vertical/_BML.dox @@ -0,0 +1,49 @@ +/*! \page BML Bulk Surface Mixed Layer + +This bulk surface mixed layer scheme was designed to be used with a +purely isopycnal model. Following \cite niiler1977, \cite oberhuber1993, +and Hallberg (\cite muller2003) the TKE budget is used to construct a +time-evolving homogeneous mixed layer. A buffer layer sits between +the mixed layer and the interior ocean to mediate between the two. + + The following processes are executed, in the order listed. + +\li 1. Undergo convective adjustment into mixed layer. +\li 2. Apply surface heating and cooling. +\li 3. Starting from the top, entrain whatever fluid the TKE budget + permits. Penetrating shortwave radiation is also applied at + this point. +\li 4. If there is any unentrained fluid that was formerly in the + mixed layer, detrain this fluid into the buffer layer. This + is equivalent to the mixed layer detraining to the Monin- + Obukhov depth. +\li 5. Divide the fluid in the mixed layer evenly into CS\%nkml pieces. +\li 6. Split the buffer layer if appropriate. + +Layers 1 to nkml are the mixed layer, nkml+1 to nkml+nkbl are the +buffer layers. The results of this subroutine are mathematically +identical if there are multiple pieces of the mixed layer with +the same density or if there is just a single layer. There is no +stability limit on the time step. + +The key parameters for the mixed layer are found in the control structure. +These include mstar, nstar, nstar2, pen\_SW\_frac, pen\_SW\_scale, and TKE\_decay. +For the \cite oberhuber1993 and \cite kraus1967 mixed layers, the values of these are: + + + +
Model variables used in the bulk mixed layer
Symbol Value in Oberhuber (1993) Value in Kraus-Turner (1967) +
pen\_SW\_frac 0.42 0.0 +
pen\_SW\_scale 15.0 m 0.0 m +
mstar 1.25 1.25 +
nstar 1 0.4 +
TKE\_decay 2.5 0.0 +
conv\_decay 0.5 0.0 +
+ +TKE\_decay is \f$1/\kappa\f$ in eq. 28 of \cite oberhuber1993, while +conv\_decay is \f$1/\mu\f$. Conv\_decay has been eliminated in favor of +the well-calibrated form for the efficiency of penetrating convection +from \cite wang2003. + +*/ diff --git a/src/parameterizations/vertical/_EPBL.dox b/src/parameterizations/vertical/_EPBL.dox new file mode 100644 index 0000000000..6134de31e0 --- /dev/null +++ b/src/parameterizations/vertical/_EPBL.dox @@ -0,0 +1,76 @@ +/*! \page EPBL Energetically-constrained Planetary Boundary Layer + +We here describe a scheme for modeling the ocean surface boundary layer +(OSBL) suitable for use in global climate models. It builds on the ideas in +\ref BML, bringing in some of the ideas from \ref subsection_kappa_shear, to +make an energetically consistent boundary layer suitable for use with +a generalized vertical coordinate. Unlike in \ref BML, variables are +allowed to have vertical structure within the boundary layer. The downward +turbulent flux of buoyant water by OSBL turbulence converts mechanical +energy into potential energy as it mixes with less buoyant water at the +base of the OSBL. As described in \cite reichl2018, we focus on OSBL +parameterizations that constrain this integrated potential energy +conversion due to turbulent mixing. + +The leading-order mean OSBL equation for arbitrary scalar \f$\phi\f$ is: + +\f[ + \frac{\partial \overline{\phi}}{\partial t} = - \frac{\partial}{\partial z} + \overline{w^\prime \phi^\prime} + \nu_\phi \frac{\partial^2 \overline{\phi}}{\partial z^2} +\f] + +where the symbols are as follows: + + + +
Symbols used in TKE equation
Symbol Meaning +
\f$u_i\f$ horizontal components of the velocity +
\f$\phi\f$ arbitrary scalar (tracer) quantity +
\f$w\f$ vertical component of the velocity +
\f$\overline{w}\f$ ensemble average \f$w\f$ +
\f$w^\prime\f$ fluctuations from \f$\overline{w}\f$ +
\f$k\f$ turbulent kinetic energy (TKE) +
\f$K_M\f$ turbulent mixing coefficient for momentum +
\f$K_\phi\f$ turbulent mixing coefficient for \f$\phi\f$ +
\f$\sigma_k\f$ turbulent Schmidt number +
\f$b\f$ buoyancy +
\f$\epsilon\f$ buoyancy turbulent dissipation rate +
+ +This equation describes the evolution of mean quantity \f$\overline{\phi}\f$ +due to vertical processes, including the often negligible molecular +mixing. We would like to parameterize the vertical mixing since we won't be +resolving all the relevant time and space scales. + +We use the Boussinesq hypothesis for turbulence closure. This approximates +the Reynolds stress terms using an eddy viscosity (eddy diffusivity for +turbulent scalar fluxes): + +\f[ + \overline{u_i^\prime w^\prime} = - K_M \frac{\partial \overline{u_i}}{\partial z} , +\f] + +Similarly, the eddy diffusivity is used to parameterize turbulent scalar fluxes as: + +\f[ + \overline{\phi^\prime w^\prime} = - K_\phi \frac{\partial \overline{\phi}}{\partial z} , +\f] + +The parameters needed to close the system of equations are then reduced to the turbulent +mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$$. + +We start with an equation for the turbulent kinetic energy (TKE): + +\f[ + \frac{\partial k}{\partial t} = \frac{\partial}{\partial z} \left( \frac{K_M}{\sigma_k} + \frac{\partial k}{\partial z} \right) - \overline{u_i^\prime w^\prime} \frac{\partial \overline{u_i}} + {\partial z} + \overline{w^\prime b^\prime} - \epsilon +\f] + + +Terms in this equation represent TKE storage (LHS), TKE flux convergence, +shear production, buoyancy production, and dissipation. + +Following the lead of \cite jackson2008 (\ref subsection_kappa_shear). + +*/ From 5adf7638051eea62fbc1b3a6f363f905b4715836 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Oct 2021 13:46:54 -0800 Subject: [PATCH 006/138] Done with EPBL docs? --- docs/conf.py | 2 +- .../vertical/MOM_energetic_PBL.F90 | 4 +- src/parameterizations/vertical/_EPBL.dox | 184 +++++++++++++++++- 3 files changed, 184 insertions(+), 6 deletions(-) diff --git a/docs/conf.py b/docs/conf.py index d705e19878..5d84b3c37a 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2020, MOM6 developers' +copyright = u'2017-2021, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index c0e5207e4e..6920b8dd22 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1030,7 +1030,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum) ! This tests whether the layers above and below this interface are in - ! a convetively stable configuration, without considering any effects of + ! a convectively stable configuration, without considering any effects of ! mixing at higher interfaces. It is an approximation to the more ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of ! mixing across interface K-1. The dT_to_dColHt here are effectively @@ -2079,7 +2079,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call log_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& - "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the stabilizing limit, as in OM4 \n"//& "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & default=CONSTANT_STRING) tmpstr = uppercase(tmpstr) diff --git a/src/parameterizations/vertical/_EPBL.dox b/src/parameterizations/vertical/_EPBL.dox index 6134de31e0..d531c9ad9a 100644 --- a/src/parameterizations/vertical/_EPBL.dox +++ b/src/parameterizations/vertical/_EPBL.dox @@ -57,7 +57,7 @@ Similarly, the eddy diffusivity is used to parameterize turbulent scalar fluxes \f] The parameters needed to close the system of equations are then reduced to the turbulent -mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$$. +mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$. We start with an equation for the turbulent kinetic energy (TKE): @@ -67,10 +67,188 @@ We start with an equation for the turbulent kinetic energy (TKE): {\partial z} + \overline{w^\prime b^\prime} - \epsilon \f] - Terms in this equation represent TKE storage (LHS), TKE flux convergence, shear production, buoyancy production, and dissipation. -Following the lead of \cite jackson2008 (\ref subsection_kappa_shear). +\section section_WMBL Well-mixed Boundary Layers (WMBL) + +Assuming steady state and other parameterizations, integrating vertically +over the surface boundary layer, \cite reichl2018 obtains the form: + +\f[ + \frac{1}{2} H_{bl} w_e \Delta b = m_\ast u_\ast^3 - n_\ast \frac{H_{bl}}{2} + B(H_{bl}) , +\f] + +with the following variables: + + + +
Symbols used in integrated TKE equation
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$w_e\f$ entrainment velocity +
\f$\Delta b\f$ change in buoyancy at base of mixed layer +
\f$m_\ast\f$ sum of mechanical coefficients +
\f$u_\ast\f$ friction velocity (\f$u_\ast = (|\tau| / \rho_0)^{1/2}\f$) +
\f$\tau\f$ wind stress +
\f$n_\ast\f$ convective proportionality coefficient +
1 for stabilizing surface buoyancy flux, less otherwise +
\f$B(H_{bl})\f$ surface buoyancy flux +
+ +\section section_ePBL Energetics-based Planetary Boundary Layer + +Once again, the goal is to formulate a surface mixing scheme to find the +turbulent eddy diffusivity (and viscosity) in a way that is suitable for use +in a global climate model, using long timesteps and large grid spacing. +After evaluating a well-mixed boundary layer (WMBL), the shear mixing of +\cite jackson2008 (JHL, \ref subsection_kappa_shear), as well as a more complete +boundary layer scheme, it was decided to combine a number of these ideas +into a new scheme: + +\f[ + K(z) = F_x(K_{ePBL}(z), K_{JHL}(z), K_n(z)) +\f] + +where \f$F_x\f$ is some unknown function of a new \f$K_{ePBL}\f$, +\f$K_{JHL}\f$, the diffusivity due to shear as determined by +\cite jackson2008, and \f$K_n\f$, the diffusivity from other ideas. +We start by specifying the form of \f$K_{ePBL}\f$ as being: + +\f[ + K_{ePBL}(z) = C_K w_t l , +\f] + +where \f$w_t\f$ is a turbulent velocity scale, \f$C_K\f$ is a coefficient, and +\f$l\f$ is a length scale. + +\subsection subsection_lengthscale Turbulent length scale + +We propose a form for the length scale as follows: + +\f[ + l = (z_0 + |z|) \times \max \left[ \frac{l_b}{H_{bl}} , \left( + \frac{H_{bl} - |z|}{H_{bl}} \right)^\gamma \, \right] , +\f] + +where we have the following variables: + + + +
Symbols used in ePBL length scale
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$z_0\f$ roughness length +
\f$\gamma\f$ coefficient, 2 is as in KPP, \cite large1994 +
\f$l_b\f$ bottom length scale +
+ +\subsection subsection_velocityscale Turbulent velocity scale + +We do not predict the TKE prognostically and therefore approximate the vertical TKE +profile to estimate \f$w_t\f$. An estimate for the mechanical contribution to the velocity +scale follows the standard two-equation approach. In one and two-equation second-order +\f$K\f$ parameterizations the boundary condition for the TKE is typically employed as a +flux boundary condition. + +\f[ + K \left. \frac{\partial k}{\partial z} \right|_{z=0} = c_\mu^0 u_\ast^3 . +\f] + +The profile of \f$k\f$ decays in the vertical from \f$k \propto (c_\mu^0)^{2/3} +u_\ast^2\f$ toward the base of the OSBL. Here we assume a similar relationship to estimate +the mechanical contribution to the TKE profile. The value of \f$w_t\f$ due to mechanical +sources, \f$v_\ast\f$, is estimate as \f$v_\ast (z=0) \propto (c_\mu^0)^{1/3} u_\ast\f$ at +the surface. Since we only parameterize OSBL turbulent mixing due to surface forcing, the +value of the velocity scale is assumed to decay moving away from the surface. For +simplicity we employ a linear decay in depth: + +\f[ + v_\ast (z) = (c_\mu^0)^{1/3} u_\ast \left( 1 - a \cdot \min \left[ 1, + \frac{|z|}{H_{bl}} \right] \right) , +\f] + +where \f$1 > a > 0\f$ has the effect of making \f$v_\ast(z=H_{bl}) > 0\f$. +Making the constant coefficient \f$a\f$ close to one has the effect of reducing the mixing +rate near the base of the boundary layer, thus producing a more diffuse entrainment +region. Making \f$a\f$ close to zero has the effect of increasing the mixing at the base +of the boundary layer, producing a more 'step-like' entrainment region. + +An estimate for the buoyancy contribution is found utilizing the convective velocity +scale: + +\f[ + w_\ast (z) = C_{w_\ast} \left( \int_z^0 \overline{w^\prime b^\prime} dz \right)^{1/3} , +\f] + +where \f$C_{w_\ast}\f$ is a non-dimensional empirical coefficient. Convection in one and +two-equation closure causes a TKE profile that peaks below the surface. The quantity +\f$\overline{w^\prime b^\prime}\f$ is solved for in ePBL as \f$KN^2\f$. + +These choices for the convective and mechanical components of the velocity scale in the +OSBL are then added together to get an estimate for the total turbulent velocity scale: + +\f[ + w_t (z) = w_\ast (z) + v_\ast (z) . +\f] + +The value of \f$a\f$ is arbitrarily chosen to be 0.95 here. + +\subsection subsection_ePBL_summary Summarizing the ePBL implementation + +The ePBL mixing coefficient is found by multiplying a velocity scale +(\ref subsection_velocityscale) by a length scale (\ref subsection_lengthscale). The +precise value of the coefficient \f$C_K\f$ used does not significantly alter the +prescribed potential energy change constraint. A reasonable value is \f$C_K \approx 0.55\f$ to +be consistent with other approaches (e.g. \cite umlauf2005). + +The boundary layer thickness (\f$H_{bl}\f$) within ePBL is based on +the depth where the energy requirement for turbulent mixing of density +exceeds the available energy (\ref section_WMBL). \f$H_{bl}\f$ is +determined by the energetic constraint imposed using the value of +\f$m_\ast\f$ and \f$n_\ast\f$. An iterative solver is required because +\f$m_\ast\f$ and the mixing length are dependent on \f$H_{bl}\f$. + +We use a constant value for convectively driven TKE of \f$n_\ast = 0.066\f$. The +parameterizations for \f$m_\ast\f$ are formulated specifically for the regimes where +\f$K_{JHL}\f$ is sensitive to model numerics \f$(|f| \Delta t \approx +1)\f$ (\cite reichl2018). + +\subsection subsection_ePBL_JHL Combining ePBL and JHL mixing coefficients + +We now address the combination of the ePBL mixing coefficient and the JHL mixing +coefficient. The function \f$F_x\f$ above cannot be the linear sum of \f$K_{ePBL}\f$ and +\f$K_{JHL}\f$. One reason this sum is not valid is because the JHL mixing coefficient is +determined by resolved current shear, including that driven by the surface wind. The +wind-driven current is also included in the ePBL mixing coefficient formulation. An +alternative approach is therefore needed to avoid double counting. + +\f$K_{ePBL}\f$ is not used at the equator as scalings are only investigated when \f$|f| > +0\f$. The solution we employ is to use the maximum mixing coefficient of the two +contributions, + +\f[ + K (z) = \max (K_{ePBL} (z), K_{JHL} (z)), +\f] + +where \f$m_\ast\f$ (and hence \f$K_{ePBL}\f$) is constrained to be small as \f$|f| +\rightarrow 0\f$. This form uses the JHL mixing coefficient when the ePBL coefficient is +small. + +This approach is reasonable when the wind-driven mixing dominates, since both JHL and ePBL +give a similar solution when deployed optimally. One weakness of this approach is the +tropical region, where the shear-driven ePBL \f$m_\ast\f$ coefficient is not formulated. +The JHL parameterization is skillful to simulate this mixing, but does not include the +contribution of convection. The convective portion of \f$K_{ePBL}\f$ should be combined +with \f$K_{JHL}\f$ in the equatorial region when shear and convection occur together. +Future research is warranted. + +Finally, one should note that the mixing coefficient here (\f$K\f$) is used for both +diffusivity and viscosity, implying a turbulent Prandtl number of 1.0. + +\subsection subsection_Langmuir Langmuir circulation + +While only briefly alluded to in \cite reichl2018, the MOM6 code implementing ePBL does +support the option to add a Langmuir parameterization. There are in fact two options, both +adjusting \f$m_\ast\f$. */ From 8e5a1b758902fad7e33194361cd6da8c22944676 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 13 Oct 2021 16:11:44 -0400 Subject: [PATCH 007/138] FMS1: Don't create IO domains for single-PE domain FMS mpp domain creation is done in the `clone_MD_to_d2D` function, and currently an IO domain is always created within the MPP domain. This has caused problems with single-PE runs in FMS1, where the `write_field` logic was not able to reach the part which removes halo data if an IO domain was present, and halo data was being written to the restart files. This issue arose when `PARALLEL_RESTARTFILES` was set to `True` for single-PE tests. This does not appear to be a problem with FMS2, and no action is needed by the FMS team. --- config_src/infra/FMS1/MOM_domain_infra.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/config_src/infra/FMS1/MOM_domain_infra.F90 b/config_src/infra/FMS1/MOM_domain_infra.F90 index 590637158f..7eff4597f3 100644 --- a/config_src/infra/FMS1/MOM_domain_infra.F90 +++ b/config_src/infra/FMS1/MOM_domain_infra.F90 @@ -1716,13 +1716,13 @@ subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & symmetry=symmetric_dom, xextent=xextent, yextent=yextent, name=dom_name) endif - if ((MD_in%io_layout(1) + MD_in%io_layout(2) > 0) .and. & - (MD_in%layout(1)*MD_in%layout(2) > 1)) then - call mpp_define_io_domain(mpp_domain, MD_in%io_layout) - else - call mpp_define_io_domain(mpp_domain, (/ 1, 1 /) ) + if (MD_in%layout(1) * MD_in%layout(2) > 1) then + if ((MD_in%io_layout(1) + MD_in%io_layout(2) > 0)) then + call mpp_define_io_domain(mpp_domain, MD_in%io_layout) + else + call mpp_define_io_domain(mpp_domain, [1, 1] ) + endif endif - end subroutine clone_MD_to_d2D !> Returns the index ranges that have been stored in a MOM_domain_type From 24e48a7824048e296f7958e68541c53f64b8cd37 Mon Sep 17 00:00:00 2001 From: wfcooke Date: Thu, 14 Oct 2021 13:34:58 -0400 Subject: [PATCH 008/138] User/wfc/remap scheme (#1503) * Revert "Implement changes suggested by @Hallberg-NOAA" This reverts commit 8f4af3d9ef927dc4b99d2a44f32a1e0a3ca5c2c3. * Revert "*Corrected the clock as seen by diabatic processes" This reverts commit bc6c6e65d658f7cdddf0c589ae770feb40287c01. * Revert "*Use rho_ref in finite volume PGF density calcs" This reverts commit 48e90d0b928457e64c80b065c32f1131cc6b6dfb. * Update of MOM6 code to allow SPEAR to reproduce previous answers. Updates MOM code to dev/gfdl as of 2/7/2019 (6dd6f5295b9af1) and reverts 3 answer changing modifications. Update produced by git revert 8f4af3d9ef927dc4b99d2a44f32a1e0a3ca5c2c3 git add src/tracer/MOM_neutral_diffusion.F90 git revert --continue git revert bc6c6e65d658f git add src/core/MOM.F90 git revert --continue git revert 48e90d0b928457 git add src/equation_of_state/MOM_EOS.F90 git revert --continue Some conflict resolution was needed. * Optional use of differing restoring piston velocities for temp and salt * Correction to ePBL code to mitigate blowup. Also "corrects" some spelling differences in variables (MStar vs mstar) * add MJHarrison-GFDL salt_flux_add_fix to SPEAR codeset from https://github.com/MJHarrison-GFDL/MOM6/compare/salt_flux_add_fix * Added ability to change remapping scheme. Added call for parameter REMAPPING_SCHEME to allow changes to be made. Previously was hardwired to PLM. Call for MOM_grid_int was issing a global_indexing=F argument Tests indicated that oda clocks were being called out of order and crashing the test, so I commented them out. * Removed timers, Changes name for REMAPPING_SCHEME parameter Changes REMAPPING_SCHEME to ODA_REMAPPING_SCHEME Removed timers that were causing blowups * Adds documentation for ODA_remapping_scheme Changes second argument to get_param calls to the module name. Co-authored-by: Matthew Harrison --- src/ocean_data_assim/MOM_oda_driver.F90 | 50 ++++++++++++------------- 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 6c36cbbacb..161cf16115 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -17,6 +17,7 @@ module MOM_oda_driver_mod use MOM_io, only : SINGLE_FILE use MOM_interp_infra, only : init_extern_field, get_external_field_info use MOM_interp_infra, only : time_interp_extern +use MOM_remapping, only : remappingSchemesDoc use MOM_time_manager, only : time_type, real_to_time, get_date use MOM_time_manager, only : operator(+), operator(>=), operator(/=) use MOM_time_manager, only : operator(==), operator(<) @@ -65,11 +66,8 @@ module MOM_oda_driver_mod !>@{ CPU time clock ID integer :: id_clock_oda_init -integer :: id_clock_oda_filter integer :: id_clock_bias_adjustment integer :: id_clock_apply_increments -integer :: id_clock_oda_prior -integer :: id_clock_oda_posterior !>@} #include @@ -142,6 +140,7 @@ module MOM_oda_driver_mod !>@{ DA parameters integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 !>@} +character(len=40) :: mdl = "MOM_oda_driver" !< This module's name. contains @@ -178,15 +177,13 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) character(len=30) :: coord_mode character(len=200) :: inputdir, basin_file logical :: reentrant_x, reentrant_y, tripolar_N, symmetric + character(len=80) :: remap_scheme character(len=80) :: bias_correction_file, inc_file if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) id_clock_oda_init=cpu_clock_id('(ODA initialization)') - id_clock_oda_prior=cpu_clock_id('(ODA setting prior)') - id_clock_oda_filter=cpu_clock_id('(ODA filter computation)') - id_clock_oda_posterior=cpu_clock_id('(ODA getting posterior)') call cpu_clock_begin(id_clock_oda_init) ! Use ens1 parameters , this could be changed at a later time @@ -195,44 +192,49 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call get_MOM_input(PF,dirs,ensemble_num=0) call unit_scaling_init(PF, CS%US) - call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, & + call get_param(PF, mdl, "ASSIM_METHOD", assim_method, & "String which determines the data assimilation method "//& "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM') - call get_param(PF, "MOM", "ASSIM_FREQUENCY", CS%assim_frequency, & + call get_param(PF, mdl, "ASSIM_FREQUENCY", CS%assim_frequency, & "data assimilation frequency in hours") - call get_param(PF, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , & + call get_param(PF, mdl, "USE_REGRIDDING", CS%use_ALE_algorithm , & "If True, use the ALE algorithm (regridding/remapping).\n"//& "If False, use the layered isopycnal algorithm.", default=.false. ) - call get_param(PF, "MOM", "REENTRANT_X", CS%reentrant_x, & + call get_param(PF, mdl, "REENTRANT_X", CS%reentrant_x, & "If true, the domain is zonally reentrant.", default=.true.) - call get_param(PF, "MOM", "REENTRANT_Y", CS%reentrant_y, & + call get_param(PF, mdl, "REENTRANT_Y", CS%reentrant_y, & "If true, the domain is meridionally reentrant.", & default=.false.) - call get_param(PF,"MOM", "TRIPOLAR_N", CS%tripolar_N, & + call get_param(PF, mdl, "TRIPOLAR_N", CS%tripolar_N, & "Use tripolar connectivity at the northern edge of the "//& "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & default=.false.) - call get_param(PF,"MOM", "APPLY_TRACER_TENDENCY_ADJUSTMENT", CS%do_bias_adjustment, & + call get_param(PF, mdl, "APPLY_TRACER_TENDENCY_ADJUSTMENT", CS%do_bias_adjustment, & "If true, add a spatio-temporally varying climatological adjustment "//& "to temperature and salinity.", & default=.false.) if (CS%do_bias_adjustment) then - call get_param(PF,"MOM", "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & + call get_param(PF, mdl, "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & "A multiplicative scaling factor for the climatological tracer tendency adjustment ", & default=1.0) endif - call get_param(PF,"MOM", "USE_BASIN_MASK", CS%use_basin_mask, & + call get_param(PF, mdl, "USE_BASIN_MASK", CS%use_basin_mask, & "If true, add a basin mask to delineate weakly connected "//& "ocean basins for the purpose of data assimilation.", & default=.false.) - call get_param(PF,"MOM", "NIGLOBAL", CS%ni, & + call get_param(PF, mdl, "NIGLOBAL", CS%ni, & "The total number of thickness grid points in the "//& "x-direction in the physical domain.") - call get_param(PF,"MOM", "NJGLOBAL", CS%nj, & + call get_param(PF, mdl, "NJGLOBAL", CS%nj, & "The total number of thickness grid points in the "//& "y-direction in the physical domain.") - call get_param(PF, 'MOM', "INPUTDIR", inputdir) + call get_param(PF, mdl, "INPUTDIR", inputdir) + call get_param(PF, mdl, "ODA_REMAPPING_SCHEME", remap_scheme, & + "This sets the reconstruction scheme used "//& + "for vertical remapping for all variables. "//& + "It can be one of the following schemes: "//& + trim(remappingSchemesDoc), default="PPM_H4") inputdir = slasher(inputdir) select case(lowercase(trim(assim_method))) @@ -281,7 +283,7 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call MOM_initialize_coord(CS%GV, CS%US, PF, .false., & dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) - call MOM_grid_init(CS%Grid, PF) + call MOM_grid_init(CS%Grid, PF, global_indexing=.false.) call ALE_updateVerticalGridType(CS%ALE_CS, CS%GV) call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) CS%mpp_domain => CS%Grid%Domain%mpp_domain @@ -300,7 +302,7 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) "Coordinate mode for vertical regridding.", & default="ZSTAR", fail_if_missing=.false.) call initialize_regridding(CS%regridCS, CS%GV, CS%US, dG%max_depth,PF,'oda_driver',coord_mode,'','') - call initialize_remapping(CS%remapCS,'PLM') + call initialize_remapping(CS%remapCS,remap_scheme) call set_regrid_params(CS%regridCS, min_thickness=0.) isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed @@ -351,7 +353,7 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) if (CS%do_bias_adjustment) then - call get_param(PF, "MOM", "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & + call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & "The name of the file containing temperature and salinity "//& "tendency adjustments", default='temp_salt_adjustment.nc') @@ -405,7 +407,6 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) !call MOM_mesg('Setting prior') - call cpu_clock_begin(id_clock_oda_prior) ! computational domain for the analysis grid isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec @@ -432,7 +433,6 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) call pass_var(CS%Ocean_prior%S(:,:,:,m),CS%Grid%domain) enddo - call cpu_clock_end(id_clock_oda_prior) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) @@ -461,7 +461,6 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) !! switch to global pelist call set_PElist(CS%filter_pelist) call MOM_mesg('Getting posterior') - call cpu_clock_begin(id_clock_oda_posterior) if (present(h)) h => CS%h ! get analysis thickness !! Calculate and redistribute increments to CS%tv right after assimilation !! Retain CS%tv to calculate increments for IAU updates CS%tv_inc otherwise @@ -490,7 +489,6 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) if (present(tv)) tv => CS%tv if (present(h)) h => CS%h - call cpu_clock_end(id_clock_oda_posterior) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) @@ -518,12 +516,10 @@ subroutine oda(Time, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) - call cpu_clock_begin(id_clock_oda_filter) call get_profiles(Time, CS%Profiles, CS%CProfiles) #ifdef ENABLE_ECDA call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid) #endif - call cpu_clock_end(id_clock_oda_filter) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) call get_posterior_tracer(Time, CS, increment=.true.) From 393df05f15cedf92b65910ca27008d363d8b767c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 14 Oct 2021 16:54:51 -0400 Subject: [PATCH 009/138] +*Change defaults for 3 parameters to better values (#1509) NOTE: Initial submission included 4 parameters. `PARALLEL_RESTARTFILES` was dropped after an issue was detected. Full commit log history below. * +*Change defaults for 4 parameters to better values Updated the defaults of 4 run-time parameters (INTERNAL_WAVE_SPEED_BETTER_EST, PARALLEL_RESTARTFILES, EPBL_MLD_BISECTION, and BBL_USE_EOS) to more appropriate values. In each case, the previous default was simply the older setting, and not the better recommendation. It also adds logic determining whether SIMPLE_TKE_TO_KD does anything, and only log its setting if it does. These default changes were discussed by the MOM6 consortium as a whole in June, 2021 and were widely agreed to. In addition this commit removes the old obsoleted runtime parameter ORIG_MLD_ITERATION, and obsoletes the runtime parameter LARGE_FILE_SUPPORT, and it adds comments describing several real variables and their units. Because this changes several default values, it will change answers unless these parameters are explicitly set in the MOM_input files. However, because MOM6-examples PR #344 does set these values to their old defaults where they are used, no answers are changed in the MOM6-examples regression suite, although there are changes to the MOM_parameter_doc files. * +Reverted default for PARALLEL_RESTARTFILES Reverted the default for PARALLEL_RESTARTFILES to False because the TC restart testing was having problems with this set to True. This is surprising because PARALLEL_RESTARTFILES = True has been used in production runs for many years now without any indication that MOM6 fails to reproduce across restarts in this mode, so this could be an issue with the TC testing. In the mean time, reverting this default will allow the other changes to be accepted while this curious behavior is explored separately. Several comments related to PARALLEL_RESTARTFILES were also updated for consistency. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 2 +- src/diagnostics/MOM_obsolete_params.F90 | 2 +- src/framework/MOM_restart.F90 | 34 +++++++------------ .../MOM_shared_initialization.F90 | 5 +-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 22 ++++++++++-- .../vertical/MOM_set_viscosity.F90 | 34 +++++++++++++------ 8 files changed, 62 insertions(+), 41 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index b3041f5afb..cf6fef06b6 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1644,7 +1644,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, & "If true, use a more robust estimate of the first mode wave speed as the "//& - "starting point for iterations.", default=.false.) !### Change the default. + "starting point for iterations.", default=.true.) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false.) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 80708df97b..034b87e91b 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -68,7 +68,6 @@ subroutine find_obsolete_params(param_file) hint="Use NUM_DIAG_COORDS, DIAG_COORDS and DIAG_COORD_DEF_Z") call obsolete_real(param_file, "VSTAR_SCALE_FACTOR", hint="Use EPBL_VEL_SCALE_FACTOR instead.") - call obsolete_logical(param_file, "ORIG_MLD_ITERATION", .false.) call obsolete_real(param_file, "VSTAR_SCALE_COEF") call obsolete_real(param_file, "ZSTAR_RIGID_SURFACE_THRESHOLD") @@ -88,6 +87,7 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) + call obsolete_logical(param_file, "LARGE_FILE_SUPPORT", .true.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 7896962bc1..5d81db10a3 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -73,10 +73,10 @@ module MOM_restart !! file. Otherwise some fields must be initialized approximately. integer :: novars = 0 !< The number of restart fields that have been registered. integer :: num_obsolete_vars = 0 !< The number of obsolete restart fields that have been registered. - logical :: parallel_restartfiles !< If true, each PE writes its own restart file, - !! otherwise they are combined internally. - logical :: large_file_support !< If true, NetCDF 3.6 or later is being used - !! and large-file-support is enabled. + logical :: parallel_restartfiles !< If true, the IO layout is used to group processors that write + !! to the same restart file or each processor writes its own + !! (numbered) restart file. If false, a single restart file is + !! generated after internally combining output from all PEs. logical :: new_run !< If true, the input filenames and restart file existence will !! result in a new run that is not initialized from restart files. logical :: new_run_set = .false. !< If true, new_run has been determined for this restart_CS. @@ -885,9 +885,10 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ ! to the name of files after the first. integer(kind=8) :: var_sz, size_in_file ! The size in bytes of each variable ! and the variables already in a file. - integer(kind=8) :: max_file_size = 2147483647_8 ! The maximum size in bytes - ! for any one file. With NetCDF3, - ! this should be 2 Gb or less. + integer(kind=8), parameter :: max_file_size = 4294967292_8 ! The maximum size in bytes for the + ! starting position of each variable in a file's record, + ! based on the use of NetCDF 3.6 or later. For earlier + ! versions of NetCDF, the value was 2147483647_8. integer :: start_var, next_var ! The starting variables of the ! current and next files. type(file_type) :: IO_handle ! The I/O handle of the open fileset @@ -910,10 +911,6 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ if (CS%novars > CS%max_fields) call restart_error(CS) ! With parallel read & write, it is possible to disable the following... - - ! The maximum file size is 4294967292, according to the NetCDF documentation. - if (CS%large_file_support) max_file_size = 4294967292_8 - num_files = 0 next_var = 0 nz = 1 ; if (present(GV)) nz = GV%ke @@ -1541,13 +1538,11 @@ subroutine restart_init(param_file, CS, restart_root) ! Determine whether all paramters are set to their default values. call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", CS%parallel_restartfiles, & default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", CS%large_file_support, & - default=.true., do_not_log=.true.) call get_param(param_file, mdl, "MAX_FIELDS", CS%max_fields, default=100, do_not_log=.true.) call get_param(param_file, mdl, "RESTART_CHECKSUMS_REQUIRED", CS%checksum_required, & default=.true., do_not_log=.true.) - all_default = ((.not.CS%parallel_restartfiles) .and. (CS%large_file_support) .and. & - (CS%max_fields == 100) .and. (CS%checksum_required)) + all_default = ((.not.CS%parallel_restartfiles) .and. (CS%max_fields == 100) .and. & + (CS%checksum_required)) if (.not.present(restart_root)) then call get_param(param_file, mdl, "RESTARTFILE", CS%restartfile, & default="MOM.res", do_not_log=.true.) @@ -1557,8 +1552,9 @@ subroutine restart_init(param_file, CS, restart_root) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "", all_default=all_default) call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", CS%parallel_restartfiles, & - "If true, each processor writes its own restart file, "//& - "otherwise a single restart file is generated", & + "If true, the IO layout is used to group processors that write to the same "//& + "restart file or each processor writes its own (numbered) restart file. "//& + "If false, a single restart file is generated combining output from all PEs.", & default=.false.) if (present(restart_root)) then @@ -1568,10 +1564,6 @@ subroutine restart_init(param_file, CS, restart_root) call get_param(param_file, mdl, "RESTARTFILE", CS%restartfile, & "The name-root of the restart file.", default="MOM.res") endif - call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", CS%large_file_support, & - "If true, use the file-size limits with NetCDF large "//& - "file support (4Gb), otherwise the limit is 2Gb.", & - default=.true.) call get_param(param_file, mdl, "MAX_FIELDS", CS%max_fields, & "The maximum number of restart fields that can be used.", & default=100) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 0baf357cbc..42d994a848 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1300,8 +1300,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) endif call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", multiple_files, & - "If true, each processor writes its own restart file, "//& - "otherwise a single restart file is generated", & + "If true, the IO layout is used to group processors that write to the same "//& + "restart file or each processor writes its own (numbered) restart file. "//& + "If false, a single restart file is generated combining output from all PEs.", & default=.false.) file_threading = SINGLE_FILE if (multiple_files) file_threading = MULTIPLE diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2d1f7103e6..972ab89da9 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1535,7 +1535,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, & "If true, use a more robust estimate of the first mode wave speed as the "//& - "starting point for iterations.", default=.false.) !### Change the default. + "starting point for iterations.", default=.true.) call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, & mono_N2_depth=N2_filter_depth, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 6920b8dd22..8557667c94 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2181,7 +2181,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "If true, use bisection with the iterative determination of the self-consistent "//& "mixed layer depth. Otherwise use the false position after a maximum and minimum "//& "bound have been evaluated and the returned value or bisection before this.", & - default=.true., do_not_log=.not.CS%Use_MLD_iteration) !### The default should become false. + default=.false., do_not_log=.not.CS%Use_MLD_iteration) call get_param(param_file, mdl, "EPBL_MLD_MAX_ITS", CS%max_MLD_its, & "The maximum number of iterations that can be used to find a self-consistent "//& "mixed layer depth. If EPBL_MLD_BISECTION is true, the maximum number "//& diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 4ce947e817..c6892249f0 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2007,9 +2007,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. - real :: omega_frac_dflt + real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate + ! that is used in place of the absolute value of the local Coriolis + ! parameter in the denominator of some expressions [nondim] logical :: Bryan_Lewis_diffusivity ! If true, the background diapycnal diffusivity uses ! the Bryan-Lewis (1979) style tanh profile. + logical :: use_regridding ! If true, use the ALE algorithm rather than layered + ! isopycnal or stacked shallow water mode. + logical :: TKE_to_Kd_used ! If true, TKE_to_Kd and maxTKE need to be calculated. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -2151,11 +2156,15 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ endif CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, & 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + + TKE_to_Kd_used = (CS%use_tidal_mixing .or. CS%ML_radiation .or. & + (CS%bottomdraglaw .and. .not.CS%use_LOTW_BBL_diffusivity)) call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will "//& "work for arbitrary vertical coordinates. If false, "//& "calculates Kd/TKE and bounds based on exact energetics "//& - "for an isopycnal layer-formulation.", default=.false.) + "for an isopycnal layer-formulation.", & + default=.false., do_not_log=.not.TKE_to_Kd_used) ! set params related to the background mixing call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp) @@ -2176,8 +2185,15 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The maximum permitted increment for the diapycnal "//& "diffusivity from TKE-based parameterizations, or a negative "//& "value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T) - if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, & + if (CS%simple_TKE_to_Kd) then + if (CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") + call get_param(param_file, mdl, "USE_REGRIDDING", use_regridding, & + do_not_log=.true., default=.false.) + if (use_regridding) call MOM_error(WARNING, & + "set_diffusivity_init: SIMPLE_TKE_TO_KD can not be used reliably with USE_REGRIDDING.") + endif + call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added "//& "everywhere without any filtering or scaling.", & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 9770325d85..e72575b86a 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1916,9 +1916,15 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables - real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt - real :: Kv_background - real :: omega_frac_dflt + real :: Csmag_chan_dflt ! The default value for SMAG_CONST_CHANNEL [nondim] + real :: smag_const1 ! The default value for the Smagorinsky Laplacian coefficient [nondim] + real :: TKE_decay_dflt ! The default value of a coeficient scaling the vertical decay + ! rate of TKE [nondim] + real :: bulk_Ri_ML_dflt ! The default bulk Richardson number for a bulk mixed layer [nondim] + real :: Kv_background ! The background kinematic viscosity in the interior [m2 s-1] + real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate that + ! is used in place of the absolute value of the local Coriolis + ! parameter in the denominator of some expressions [nondim] real :: Z_rescale ! A rescaling factor for heights from the representation in ! a restart file to the internal representation in this run. real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run @@ -1930,7 +1936,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS logical :: default_2018_answers logical :: use_kappa_shear, adiabatic, use_omega, MLE_use_PBL_MLD logical :: use_KPP - logical :: use_regridding + logical :: use_regridding ! If true, use the ALE algorithm rather than layered + ! isopycnal or stacked shallow water mode. + logical :: use_temperature ! If true, temperature and salinity are used as state variables. + logical :: use_EOS ! If true, density calculated from T & S using an equation of state. character(len=200) :: filename, tideamp_file type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type ! This include declares and sets the variable "version". @@ -2071,15 +2080,18 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "USE_REGRIDDING", use_regridding, & - do_not_log = .true., default = .false. ) + do_not_log=.true., default=.false. ) + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & + default=.true., do_not_log=.true.) + call get_param(param_file, mdl, "USE_EOS", use_EOS, & + default=use_temperature, do_not_log=.true.) call get_param(param_file, mdl, "BBL_USE_EOS", CS%BBL_use_EOS, & - "If true, use the equation of state in determining the "//& - "properties of the bottom boundary layer. Otherwise use "//& - "the layer target potential densities. The default of "//& - "this is determined by USE_REGRIDDING.", default=use_regridding) + "If true, use the equation of state in determining the properties of the "//& + "bottom boundary layer. Otherwise use the layer target potential densities. "//& + "The default of this parameter is the value of USE_EOS.", & + default=use_EOS, do_not_log=.not.use_temperature) if (use_regridding .and. (.not. CS%BBL_use_EOS)) & - call MOM_error(FATAL,"When using MOM6 in ALE mode it is required to "//& - "set BBL_USE_EOS to True") + call MOM_error(FATAL,"When using MOM6 in ALE mode it is required to set BBL_USE_EOS to True.") endif call get_param(param_file, mdl, "BBL_THICK_MIN", CS%BBL_thick_min, & "The minimum bottom boundary layer thickness that can be "//& From 5bc0be3e118d3437d426a5affb0fafdf1204623e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 14 Oct 2021 19:27:46 -0400 Subject: [PATCH 010/138] +Add new parameter FATAL_INCONSISTENT_RESTART_TIME (#1511) Add the new runtime parameter FATAL_INCONSISTENT_RESTART_TIME, which if true causes the model to compare the restart time read from a restart file with any value provided as a time_in to MOM_initialize_state and issue a fatal error if they differ. In ocean-only mode, this input time is read from a ocean_solo.res file, following FMS behavior. The default value simply uses the specified time, replicating the previous behavior. If set to true, this would prevent a problem with the time-history that recently occurred in a series of high-resolution runs that were shared between several groups, where the nominal times were repeated. All answers are bitwise identical, but many MOM_parameter_doc files have a new entry. --- .../MOM_state_initialization.F90 | 21 ++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 1ca466b7fa..641b2ae382 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -34,7 +34,7 @@ module MOM_state_initialization use MOM_ALE_sponge, only : set_up_ALE_sponge_field, set_up_ALE_sponge_vel_field use MOM_ALE_sponge, only : ALE_sponge_CS, initialize_ALE_sponge use MOM_string_functions, only : uppercase, lowercase -use MOM_time_manager, only : time_type +use MOM_time_manager, only : time_type, operator(/=) use MOM_tracer_registry, only : tracer_registry_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs @@ -163,6 +163,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & logical :: new_sim integer :: write_geom logical :: use_temperature, use_sponge, use_OBC, use_oda_incupd + logical :: verify_restart_time logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. logical :: depress_sfc ! If true, remove the mass that would be displaced ! by a large surface pressure by squeezing the column. @@ -235,14 +236,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & depth_tot(i,j) = G%bathyT(i,j) + G%Z_ref enddo ; enddo + call get_param(PF, mdl, "FATAL_INCONSISTENT_RESTART_TIME", verify_restart_time, & + "If true and a time_in value is provided to MOM_initialize_state, verify that "//& + "the time read from a restart file is the same as time_in, and issue a fatal "//& + "error if it is not. Otherwise, simply set the time to time_in if present.", & + default=.false.) + ! The remaining initialization calls are done, regardless of whether the ! fields are actually initialized here (if just_read=.false.) or whether it ! is just to make sure that all valid parameters are read to enable the ! detection of unused parameters. call get_param(PF, mdl, "INIT_LAYERS_FROM_Z_FILE", from_Z_file, & - "If true, initialize the layer thicknesses, temperatures, "//& - "and salinities from a Z-space file on a latitude-longitude "//& - "grid.", default=.false., do_not_log=just_read) + "If true, initialize the layer thicknesses, temperatures, and "//& + "salinities from a Z-space file on a latitude-longitude grid.", & + default=.false., do_not_log=just_read) if (from_Z_file) then ! Initialize thickness and T/S from z-coordinate data in a file. @@ -507,7 +514,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This line calls a subroutine that reads the initial conditions ! from a previously generated file. call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, G, restart_CS) - if (present(Time_in)) Time = Time_in + if (present(Time_in)) then + if (verify_restart_time .and. (Time /= Time_in)) call MOM_error(FATAL, & + "MOM6 attempted to restart from a file from a different time than given by Time_in.") + Time = Time_in + endif if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo From 85afd241161fb0299d0d36f31dd3227b7804772c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 15 Oct 2021 08:27:29 -0400 Subject: [PATCH 011/138] +(*)Fix bug when RES_SCALE_MEKE_VISC = True (#1512) * +(*)Fix bug when RES_SCALE_MEKE_VISC = True Fix a bug that can lead to segmentation faults when RES_SCALE_MEKE_VISC is true, as noted in MOM6 issue #1464, and add better error handling to detect related problems. The refactoring that is a part of this may also avoid some problems with optimized code even when RES_SCALE_MEKE_VISC it false, as described in MOM6 issue #1463. In addition, logic was added so that the value of RES_SCALE_MEKE_VISC is only logged if USE_MEKE is true. All answers are bitwise identical in cases that worked, including the MOM6-examples test suite, but there are some changes in the MOM_parameter_doc files, due to an irrelevant parameter no longer being logged. * (*)Initialize CS%res_scale_MEKE Initialize the logical element res_scale_MEKE in the hor_visc_CS even if there is no Laplacian viscosity, so that a self-consistency test does not use an initialized value. Also improved some comments. All answers are bitwise identical for all cases that successfully ran before, including in all cases in the MOM6-examples test suite. --- .../lateral/MOM_hor_visc.F90 | 61 ++++++++++++------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 23 ++++--- 2 files changed, 56 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 7a3e56ef63..15e8415474 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -433,21 +433,29 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) endif + ! Toggle whether to use a Laplacian viscosity derived from MEKE + if (associated(MEKE)) then + use_MEKE_Ku = associated(MEKE%Ku) + use_MEKE_Au = associated(MEKE%Au) + else + use_MEKE_Ku = .false. ; use_MEKE_Au = .false. + endif + rescale_Kh = .false. if (associated(VarMix)) then rescale_Kh = VarMix%Resoln_scaled_Kh - if (rescale_Kh .and. & + if ((rescale_Kh .or. CS%res_scale_MEKE) .and. & (.not.associated(VarMix%Res_fn_h) .or. .not.associated(VarMix%Res_fn_q))) & - call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and " //& - "VarMix%Res_fn_q both need to be associated with Resoln_scaled_Kh.") + call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and VarMix%Res_fn_q "//& + "both need to be associated with Resoln_scaled_Kh or RES_SCALE_MEKE_VISC.") + elseif (CS%res_scale_MEKE) then + call MOM_error(FATAL, "MOM_hor_visc: VarMix needs to be associated if "//& + "RES_SCALE_MEKE_VISC is True.") endif + legacy_bound = (CS%Smagorinsky_Kh .or. CS%Leith_Kh) .and. & (CS%bound_Kh .and. .not.CS%better_bound_Kh) - ! Toggle whether to use a Laplacian viscosity derived from MEKE - use_MEKE_Ku = associated(MEKE%Ku) - use_MEKE_Au = associated(MEKE%Au) - if (CS%use_GME) then do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 boundary_mask_h(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) @@ -892,8 +900,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! CS%Leith_Kh - meke_res_fn = 1. - if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 sh_xx_sq = sh_xx(i,j) * sh_xx(i,j) @@ -977,13 +983,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Kh(i,j) = max(Kh(i,j), CS%Kh_bg_min) enddo ; enddo - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_h(i,j) - - if (use_MEKE_Ku) & - ! *Add* the MEKE contribution (might be negative) - Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j) * meke_res_fn - enddo ; enddo + if (use_MEKE_Ku) then + ! *Add* the MEKE contribution (which might be negative) + if (CS%res_scale_MEKE) then + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j) * VarMix%Res_fn_h(i,j) + enddo ; enddo + else + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j) + enddo ; enddo + endif + endif if (CS%anisotropic) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1803,6 +1814,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) ! valid parameters. logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. + logical :: use_MEKE ! If true, the MEKE parameterization is in use. logical :: default_2018_answers character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians @@ -1828,16 +1840,19 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) CS%diag => diag ! Read parameters and write them to the model log. call log_version(param_file, mdl, version, "") - ! It is not clear whether these initialization lines are needed for the + ! It is not clear whether all of these initialization lines are needed for the ! cases where the corresponding parameters are not read. CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false. CS%use_QG_Leith_visc = .false. CS%bound_Coriolis = .false. CS%Modified_Leith = .false. - CS%anisotropic = .false. CS%dynamic_aniso = .false. Kh = 0.0 ; Ah = 0.0 + ! These initialization lines are needed because they are used even in cases where they are not read. + CS%anisotropic = .false. + CS%res_scale_MEKE = .false. + ! If GET_ALL_PARAMS is true, all parameters are read in all cases to enable ! parameter spelling checks. call get_param(param_file, mdl, "GET_ALL_PARAMS", get_all, default=.false.) @@ -1885,13 +1900,17 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & "If true, use a Leith nonlinear eddy viscosity.", & default=.false.) + ! This call duplicates one that occurs 26 lines later, and is probably unneccessary. call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & "If true, add a term to Leith viscosity which is "//& "proportional to the gradient of divergence.", & default=.false.) + call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & + default=.false., do_not_log=.true.) call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & "If true, the viscosity contribution from MEKE is scaled by "//& - "the resolution function.", default=.false.) + "the resolution function.", default=.false., do_not_log=.not.use_MEKE) + if (.not.use_MEKE) CS%res_scale_MEKE = .false. if (CS%Leith_Kh .or. get_all) then call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & "The nondimensional Laplacian Leith constant, "//& @@ -1901,7 +1920,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) "If true, use QG Leith nonlinear eddy viscosity.", & default=.false.) if (CS%use_QG_Leith_visc .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & - "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& + "MOM_hor_visc.F90, hor_visc_init:"//& "LEITH_KH must be True when USE_QG_LEITH_VISC=True.") endif if (CS%Leith_Kh .or. CS%Leith_Ah .or. get_all) then @@ -1909,7 +1928,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) "If true, include the beta term in the Leith nonlinear eddy viscosity.", & default=CS%Leith_Kh) call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & - "If true, add a term to Leith viscosity which is \n"//& + "If true, add a term to Leith viscosity which is "//& "proportional to the gradient of divergence.", & default=.false.) endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 972ab89da9..d0df4b81ba 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -26,6 +26,9 @@ module MOM_lateral_mixing_coeffs !> Variable mixing coefficients type, public :: VarMix_CS logical :: use_variable_mixing !< If true, use the variable mixing. + logical :: Resoln_scaling_used !< If true, a resolution function is used somewhere to scale + !! away one of the viscosities or diffusivities when the + !! deformation radius is well resolved. logical :: Resoln_scaled_Kh !< If true, scale away the Laplacian viscosity !! when the deformation radius is well resolved. logical :: Resoln_scaled_KhTh !< If true, scale away the thickness diffusivity @@ -1162,6 +1165,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) real :: grid_sp_u3, grid_sp_v3 ! Intermediate quantities for Leith metrics [L3 ~> m3] real :: wave_speed_min ! A floor in the first mode speed below which 0 is returned [L T-1 ~> m s-1] real :: wave_speed_tol ! The fractional tolerance for finding the wave speeds [nondim] + logical :: Resoln_scaled_MEKE_visc ! If true, the viscosity contribution from MEKE is + ! scaled by the resolution function. logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. ! This include declares and sets the variable "version". @@ -1217,6 +1222,12 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If true, the epipycnal tracer diffusivity is scaled "//& "away when the first baroclinic deformation radius is "//& "well resolved.", default=.false.) + call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", Resoln_scaled_MEKE_visc, & + "If true, the viscosity contribution from MEKE is scaled by "//& + "the resolution function.", default=.false., do_not_log=.true.) ! Logged elsewhere. + if (.not.use_MEKE) Resoln_scaled_MEKE_visc = .false. call get_param(param_file, mdl, "RESOLN_USE_EBT", CS%Resoln_use_ebt, & "If true, uses the equivalent barotropic wave speed instead "//& "of first baroclinic wave for calculating the resolution fn.",& @@ -1245,13 +1256,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & default=.false., do_not_log=.true.) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn - call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & - default=.false., do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE ! Indicate whether to calculate the Eady growth rate - CS%calculate_Eady_growth_rate = use_MEKE & - .or. (KhTr_Slope_Cff>0.) & - .or. (KhTh_Slope_Cff>0.) + CS%calculate_Eady_growth_rate = use_MEKE .or. (KhTr_Slope_Cff>0.) .or. (KhTh_Slope_Cff>0.) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & default=0., do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (KhTr_passivity_coeff>0.) @@ -1383,7 +1390,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif oneOrTwo = 1.0 - if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then + CS%Resoln_scaling_used = CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. & + CS%Resoln_scaled_KhTr .or. Resoln_scaled_MEKE_visc + if (CS%Resoln_scaling_used) then CS%calculate_Rd_dx = .true. CS%calculate_res_fns = .true. allocate(CS%Res_fn_h(isd:ied,jsd:jed), source=0.0) @@ -1615,7 +1624,7 @@ subroutine VarMix_end(CS) if (associated(CS%L2u)) deallocate(CS%L2u) if (associated(CS%L2v)) deallocate(CS%L2v) - if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then + if (CS%Resoln_scaling_used) then deallocate(CS%Res_fn_h) deallocate(CS%Res_fn_q) deallocate(CS%Res_fn_u) From 4d9ed4fd1c2bf4dbb93022c8ec4ef63f157ae56c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 15 Oct 2021 15:42:00 -0400 Subject: [PATCH 012/138] +Make 37 optional arguments in src/core mandatory Made 37 optional arguments that are always present in calls into non-optional arguments to routines in the src/core directory. Many of these are pointer arguments related to things like open boundary conditions, so if these types are not to be used, they are simply not allocated. In several cases, this required the order of the arguments to be shifted around, but the various types of the arguments should prevent the model from compiling if the calls (e.g., in user-modified code that is not in the github repository) are not changed equivalently. Also eliminated 3 internal arguments in MOM_barotropic.F90 that are always hard-coded to the same values (the maximize argument to BT_cont_to_face_areas()) or are never used (the guess arguments to uhbt_to_ubt() and vhbt_to_vbt()), along with the code that they would exercise. All answers and output are bitwise identical. --- src/core/MOM.F90 | 11 +- src/core/MOM_PressureForce.F90 | 5 +- src/core/MOM_PressureForce_FV.F90 | 16 +- src/core/MOM_PressureForce_Montgomery.F90 | 22 +-- src/core/MOM_barotropic.F90 | 214 ++++++++-------------- src/core/MOM_continuity.F90 | 7 +- src/core/MOM_continuity_PPM.F90 | 88 +++++---- src/core/MOM_dynamics_split_RK2.F90 | 41 ++--- src/core/MOM_dynamics_unsplit.F90 | 12 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +- src/core/MOM_open_boundary.F90 | 2 +- src/core/MOM_transcribe_grid.F90 | 4 +- 12 files changed, 176 insertions(+), 256 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 73a7cd58a7..e8c770d247 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3056,8 +3056,8 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) 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)), intent(inout) :: ssh !< time mean surface height [m] - real, dimension(:,:), optional, pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa] - logical, optional, intent(in) :: use_EOS !< If true, calculate the density for + real, dimension(:,:), pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa] + logical, intent(in) :: use_EOS !< If true, calculate the density for !! the SSH correction using the equation of state. real :: Rho_conv(SZI_(G)) ! The density used to convert surface pressure to @@ -3069,9 +3069,8 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec EOSdom(:) = EOS_domain(G%HI) - if (present(p_atm)) then ; if (associated(p_atm)) then - calc_rho = associated(tv%eqn_of_state) - if (present(use_EOS) .and. calc_rho) calc_rho = use_EOS + if (associated(p_atm)) then + calc_rho = use_EOS .and. associated(tv%eqn_of_state) ! Correct the output sea surface height for the contribution from the ice pressure. do j=js,je if (calc_rho) then @@ -3087,7 +3086,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) enddo endif enddo - endif ; endif + endif end subroutine adjust_ssh_for_p_atm diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 2316bb9725..dbc01dcc27 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -50,8 +50,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e 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 + real, dimension(:,:), 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_(GV)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer @@ -89,7 +88,7 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_CS), pointer :: CS !< Pressure force control structure - type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tide control structure + type(tidal_forcing_CS), pointer :: tides_CSp !< Tide control structure #include "version_variable.h" character(len=40) :: mdl = "MOM_PressureForce" ! This module's name. diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 23e58272ed..1963d3f2c5 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -86,7 +86,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ 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 + real, dimension(:,:), 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_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies @@ -167,8 +167,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ "MOM_PressureForce_FV_nonBouss: The Stanley parameterization is not yet"//& "implemented in non-Boussinesq mode.") - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif + use_p_atm = associated(p_atm) use_EOS = associated(tv%eqn_of_state) use_ALE = .false. if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS @@ -425,7 +424,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm 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 + real, dimension(:,:), 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_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies @@ -501,8 +500,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_FV_Bouss: Module must be initialized before it is used.") - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif + use_p_atm = associated(p_atm) use_EOS = associated(tv%eqn_of_state) do i=Isq,Ieq+1 ; p0(i) = 0.0 ; enddo use_ALE = .false. @@ -808,7 +806,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure - type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure + type(tidal_forcing_CS), pointer :: tides_CSp !< Tides control structure ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. @@ -821,9 +819,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS else ; allocate(CS) ; endif CS%diag => diag ; CS%Time => Time - if (present(tides_CSp)) then - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp - endif + if (associated(tides_CSp)) CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_FV" call log_version(param_file, mdl, version, "") diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 05e68aef12..e832f72158 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -71,7 +71,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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 + real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in @@ -133,9 +133,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb 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) - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif - is_split = .false. ; if (present(pbce)) is_split = .true. + use_p_atm = associated(p_atm) + is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) if (.not.associated(CS)) call MOM_error(FATAL, & @@ -368,7 +367,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, 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 + real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies @@ -421,9 +420,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, 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) - use_p_atm = .false. - if (present(p_atm)) then ; if (associated(p_atm)) use_p_atm = .true. ; endif - is_split = .false. ; if (present(pbce)) is_split = .true. + use_p_atm = associated(p_atm) + is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) if (.not.associated(CS)) call MOM_error(FATAL, & @@ -826,8 +824,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure - type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure + type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure + type(tidal_forcing_CS), pointer :: tides_CSp !< Tides control structure ! Local variables logical :: use_temperature, use_EOS @@ -842,9 +840,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ else ; allocate(CS) ; endif CS%diag => diag ; CS%Time => Time - if (present(tides_CSp)) then - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp - endif + if (associated(tides_CSp)) CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_Mont" call log_version(param_file, mdl, version, "") diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index f912ff3275..131b7f705d 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -409,8 +409,8 @@ module MOM_barotropic subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, & eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, & eta_out, uhbtav, vhbtav, G, GV, US, CS, & - visc_rem_u, visc_rem_v, etaav, ADp, OBC, BT_cont, eta_PF_start, & - taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) + visc_rem_u, visc_rem_v, ADp, OBC, BT_cont, eta_PF_start, & + taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0, etaav) 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 @@ -460,28 +460,28 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! 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_(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 - type(ocean_OBC_type), optional, pointer :: OBC !< The open boundary condition structure. - type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe + type(accel_diag_ptrs), pointer :: ADp !< Acceleration diagnostic pointers + type(ocean_OBC_type), pointer :: OBC !< The open boundary condition structure. + type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic !! flow. - real, dimension(:,:), optional, pointer :: eta_PF_start !< The eta field consistent with the pressure + real, dimension(:,:), pointer :: eta_PF_start !< The eta field consistent with the pressure !! gradient at the start of the barotropic stepping !! [H ~> m or kg m-2]. - real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from + real, dimension(:,:), pointer :: taux_bot !< The zonal bottom frictional stress from !! ocean to the seafloor [R L Z T-2 ~> Pa]. - real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress + real, dimension(:,:), pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor [R L Z T-2 ~> Pa]. - real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference + real, dimension(:,:,:), pointer :: uh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate + real, dimension(:,:,:), pointer :: u_uh0 !< The velocities used to calculate !! uh0 [L T-1 ~> m s-1] - real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference + real, dimension(:,:,:), pointer :: vh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate + real, dimension(:,:,:), pointer :: v_vh0 !< The velocities used to calculate !! vh0 [L T-1 ~> m s-1] + 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]. ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been @@ -709,12 +709,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Idt = 1.0 / dt accel_underflow = CS%vel_underflow * Idt - use_BT_cont = .false. - if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) + use_BT_cont = associated(BT_cont) integral_BT_cont = use_BT_cont .and. CS%integral_BT_cont - interp_eta_PF = .false. - if (present(eta_PF_start)) interp_eta_PF = (associated(eta_PF_start)) + interp_eta_PF = associated(eta_PF_start) project_velocity = CS%BT_project_velocity @@ -728,11 +726,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, find_PF = (do_ave .and. ((CS%id_PFu_bt > 0) .or. (CS%id_PFv_bt > 0))) find_Cor = (do_ave .and. ((CS%id_Coru_bt > 0) .or. (CS%id_Corv_bt > 0))) - add_uh0 = .false. - if (present(uh0)) add_uh0 = associated(uh0) - if (add_uh0 .and. .not.(present(vh0) .and. present(u_uh0) .and. & - present(v_vh0))) call MOM_error(FATAL, & - "btstep: vh0, u_uh0, and v_vh0 must be present if uh0 is used.") + add_uh0 = associated(uh0) if (add_uh0 .and. .not.(associated(vh0) .and. associated(u_uh0) .and. & associated(v_vh0))) call MOM_error(FATAL, & "btstep: vh0, u_uh0, and v_vh0 must be associated if uh0 is used.") @@ -745,7 +739,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, apply_OBCs = .false. ; CS%BT_OBC%apply_u_OBCs = .false. ; CS%BT_OBC%apply_v_OBCs = .false. apply_OBC_open = .false. apply_OBC_flather = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then CS%BT_OBC%apply_u_OBCs = OBC%open_u_BCs_exist_globally .or. OBC%specified_u_BCs_exist_globally CS%BT_OBC%apply_v_OBCs = OBC%open_v_BCs_exist_globally .or. OBC%specified_v_BCs_exist_globally apply_OBC_flather = open_boundary_query(OBC, apply_Flather_OBC=.true.) @@ -756,7 +750,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (apply_OBC_flather .and. .not.GV%Boussinesq) call MOM_error(FATAL, & "btstep: Flather open boundary conditions have not yet been "// & "implemented for a non-Boussinesq model.") - endif ; endif + endif num_cycles = 1 if (CS%use_wide_halos) & @@ -1074,9 +1068,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, CS%BT_Domain, 1+ievf-ie) else if (CS%Nonlinear_continuity) then - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1, eta) else - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1) endif endif @@ -1130,10 +1124,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (integral_BT_cont) then call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, US, MS, halo=1+ievf-ie, dt_baroclinic=dt) + G, US, MS, 1+ievf-ie, dt_baroclinic=dt) else call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, US, MS, halo=1+ievf-ie) + G, US, MS, 1+ievf-ie) endif endif if (integral_BT_cont) then @@ -1279,17 +1273,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, else BT_force_v(i,J) = 0.0 endif ; enddo ; enddo - if (present(taux_bot) .and. present(tauy_bot)) then if (associated(taux_bot) .and. associated(tauy_bot)) then - !$OMP parallel do default(shared) - do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then - BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) - endif ; enddo ; enddo - !$OMP parallel do default(shared) - do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then - BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) - endif ; enddo ; enddo - endif + !$OMP parallel do default(shared) + do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then + BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) + endif ; enddo ; enddo + !$OMP parallel do default(shared) + do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then + BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) + endif ; enddo ; enddo endif ! bc_accel_u & bc_accel_v are only available on the potentially @@ -1563,7 +1555,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, associated(forces%rigidity_ice_v)) H_min_dyn = GV%Z_to_H * CS%Dmin_dyn_psurf if (ice_is_rigid .and. use_BT_cont) & - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0) if (ice_is_rigid) then !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength) do j=js,je ; do i=is,ie @@ -1776,7 +1768,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if ((.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. & (CS%Nonlin_cont_update_period > 0)) then if ((n>1) .and. (mod(n-1,CS%Nonlin_cont_update_period) == 0)) & - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1+iev-ie) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1+iev-ie, eta) endif if (integral_BT_cont) then @@ -2681,33 +2673,33 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%id_frhatv1 > 0) CS%frhatv1(:,:,:) = CS%frhatv(:,:,:) endif - if ((present(ADp)) .and. (associated(ADp%diag_hfrac_u))) then + if (associated(ADp%diag_hfrac_u)) then do k=1,nz ; do j=js,je ; do I=is-1,ie ADp%diag_hfrac_u(I,j,k) = CS%frhatu(I,j,k) enddo ; enddo ; enddo endif - if ((present(ADp)) .and. (associated(ADp%diag_hfrac_v))) then + if (associated(ADp%diag_hfrac_v)) then do k=1,nz ; do J=js-1,je ; do i=is,ie ADp%diag_hfrac_v(i,J,k) = CS%frhatv(i,J,k) enddo ; enddo ; enddo endif - if ((present(ADp)) .and. (present(BT_cont)) .and. (associated(ADp%diag_hu))) then + if (use_BT_cont .and. associated(ADp%diag_hu)) then do k=1,nz ; do j=js,je ; do I=is-1,ie ADp%diag_hu(I,j,k) = BT_cont%h_u(I,j,k) enddo ; enddo ; enddo endif - if ((present(ADp)) .and. (present(BT_cont)) .and. (associated(ADp%diag_hv))) then + if (use_BT_cont .and. associated(ADp%diag_hv)) then do k=1,nz ; do J=js-1,je ; do i=is,ie ADp%diag_hv(i,J,k) = BT_cont%h_v(i,J,k) enddo ; enddo ; enddo endif - if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + if (associated(ADp%visc_rem_u)) then do k=1,nz ; do j=js,je ; do I=is-1,ie ADp%visc_rem_u(I,j,k) = visc_rem_u(I,j,k) enddo ; enddo ; enddo endif - if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + if (associated(ADp%visc_rem_u)) then do k=1,nz ; do J=js-1,je ; do i=is,ie ADp%visc_rem_v(i,J,k) = visc_rem_v(i,J,k) enddo ; enddo ; enddo @@ -2790,11 +2782,11 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) if (use_BT_cont) then - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0) elseif (CS%Nonlinear_continuity .and. present(eta)) then - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta=eta, halo=0) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, eta=eta) else - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=0, add_max=add_SSH) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, add_max=add_SSH) endif det_de = 0.0 @@ -3593,7 +3585,7 @@ end function find_duhbt_du !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True !! this finds the time-integrated velocity that is consistent with a time-integrated transport. -function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) +function uhbt_to_ubt(uhbt, BTC) result(ubt) real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for, !! [H L2 T-1 ~> m3 s-1 or kg s-1] or the time-integrated !! transport [H L2 ~> m3 or kg]. @@ -3601,8 +3593,6 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) !! barotropic transports to be calculated consistently with the !! layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1] or [L ~> m]. - !! The result is not allowed to be dramatically larger than guess. real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1] !! or the time-integrated velocity [L ~> m]. @@ -3676,18 +3666,6 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) ubt = BTC%uBT_WW + (uhbt - BTC%uh_WW) / BTC%FA_u_WW endif - if (present(guess)) then - dvel = abs(ubt) - vs1*abs(guess) - if (dvel > 0.0) then ! Limit the velocity - if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then - vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1))) - else ! The exp is less than 4e-18 anyway in this case, so neglect it. - vsr = vs2 - endif - ubt = SIGN(vsr * guess, ubt) - endif - endif - end function uhbt_to_ubt !> The function find_vhbt determines the meridional transport for a given velocity, or with @@ -3742,7 +3720,7 @@ end function find_dvhbt_dv !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True !! this finds the time-integrated velocity that is consistent with a time-integrated transport. -function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) +function vhbt_to_vbt(vhbt, BTC) result(vbt) real, intent(in) :: vhbt !< The barotropic meridional transport that should be !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1] or the !! time-integrated transport [H L2 ~> m3 or kg]. @@ -3750,8 +3728,6 @@ function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) !! barotropic transports to be calculated consistently !! with the layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real, optional, intent(in) :: guess !< A guess at what vbt will be [L T-1 ~> m s-1] or [L ~> m]. - !! The result is not allowed to be dramatically larger than guess. real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1] !! or the time-integrated velocity [L ~> m]. @@ -3825,40 +3801,25 @@ function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) vbt = BTC%vBT_SS + (vhbt - BTC%vh_SS) / BTC%FA_v_SS endif - if (present(guess)) then - dvel = abs(vbt) - vs1*abs(guess) - if (dvel > 0.0) then ! Limit the velocity - if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then - vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1))) - else ! The exp is less than 4e-18 anyway in this case, so neglect it. - vsr = vs2 - endif - vbt = SIGN(guess * vsr, vbt) - endif - endif - end function vhbt_to_vbt !> This subroutine sets up reordered versions of the BT_cont type in the !! local_BT_cont types, which have wide halos properly filled in. subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo, dt_baroclinic) - type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the - !! barotropic solver. - type(memory_size_type), intent(in) :: MS !< A type that describes the - !! memory sizes of the argument - !! arrays. - type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(out) :: BTCL_u !< A structure with the u - !! information from BT_cont. - type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v - !! information from BT_cont. - 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(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating - !! the halos of wide arrays. - integer, optional, intent(in) :: halo !< The extra halo size to use here. - real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step - !! [T ~> s], which is provided if - !! INTEGRAL_BT_CONTINUITY is true. + type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the barotropic solver + type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of + !! the argument arrays + type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & + intent(out) :: BTCL_u !< A structure with the u information from BT_cont + type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & + intent(out) :: BTCL_v !< A structure with the v information from BT_cont + 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(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating the halos + !! of wide arrays + integer, intent(in) :: halo !< The extra halo size to use here + real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which + !! is provided if INTEGRAL_BT_CONTINUITY is true. ! Local variables real, dimension(SZIBW_(MS),SZJW_(MS)) :: & @@ -3874,7 +3835,7 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - hs = 1 ; if (present(halo)) hs = max(halo,0) + hs = max(halo,0) dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic ! Copy the BT_cont arrays into symmetric, potentially wide haloed arrays. @@ -3999,7 +3960,7 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & intent(out) :: BTCL_v !< A structure with the v information from BT_cont. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, optional, intent(in) :: halo !< The extra halo size to use here. + integer, intent(in) :: halo !< The extra halo size to use here. real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which is !! provided if INTEGRAL_BT_CONTINUITY is true. @@ -4013,7 +3974,7 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - hs = 1 ; if (present(halo)) hs = max(halo,0) + hs = max(halo,0) dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic !$OMP parallel do default(shared) @@ -4079,9 +4040,9 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & end subroutine adjust_local_BT_cont_types -!> This subroutine uses the BTCL types to find typical or maximum face +!> This subroutine uses the BT_cont_type to find the maximum face !! areas, which can then be used for finding wave speeds, etc. -subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize) +subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo) type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the !! barotropic solver. type(memory_size_type), intent(in) :: MS !< A type that describes the memory @@ -4091,35 +4052,22 @@ subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize) real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1]. 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The extra halo size to use here. - logical, optional, intent(in) :: maximize !< If present and true, find the - !! maximum face area for any velocity. ! Local variables - logical :: find_max integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec hs = 1 ; if (present(halo)) hs = max(halo,0) - find_max = .false. ; if (present(maximize)) find_max = maximize - if (find_max) then - do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = max(BT_cont%FA_u_EE(I,j), BT_cont%FA_u_E0(I,j), & - BT_cont%FA_u_W0(I,j), BT_cont%FA_u_WW(I,j)) - enddo ; enddo - do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = max(BT_cont%FA_v_NN(i,J), BT_cont%FA_v_N0(i,J), & - BT_cont%FA_v_S0(i,J), BT_cont%FA_v_SS(i,J)) - enddo ; enddo - else - do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = 0.5 * (BT_cont%FA_u_E0(I,j) + BT_cont%FA_u_W0(I,j)) - enddo ; enddo - do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = 0.5 * (BT_cont%FA_v_N0(i,J) + BT_cont%FA_v_S0(i,J)) - enddo ; enddo - endif + do j=js-hs,je+hs ; do I=is-1-hs,ie+hs + Datu(I,j) = max(BT_cont%FA_u_EE(I,j), BT_cont%FA_u_E0(I,j), & + BT_cont%FA_u_W0(I,j), BT_cont%FA_u_WW(I,j)) + enddo ; enddo + do J=js-1-hs,je+hs ; do i=is-hs,ie+hs + Datv(i,J) = max(BT_cont%FA_v_NN(i,J), BT_cont%FA_v_N0(i,J), & + BT_cont%FA_v_S0(i,J), BT_cont%FA_v_SS(i,J)) + enddo ; enddo end subroutine BT_cont_to_face_areas @@ -4133,7 +4081,7 @@ end subroutine swap !> This subroutine determines the open face areas of cells for calculating !! the barotropic transport. -subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) +subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1]. @@ -4144,10 +4092,10 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. + integer, intent(in) :: halo !< The halo size to use, default = 1. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & optional, intent(in) :: eta !< The barotropic free surface height anomaly !! or column mass anomaly [H ~> m or kg m-2]. - integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used !! to overestimate the external wave speed) [Z ~> m]. @@ -4155,7 +4103,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2]. integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - hs = 1 ; if (present(halo)) hs = max(halo,0) + hs = max(halo,0) !$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,G,CS,Datu,Datv,add_max) & !$OMP private(H1,H2) @@ -4308,12 +4256,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must !! be recalculated before stepping. - type(BT_cont_type), optional, & - pointer :: BT_cont !< A structure with elements that describe the + type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of !! barotropic flow. - type(tidal_forcing_CS), optional, & - pointer :: tides_CSp !< A pointer to the control structure of the + type(tidal_forcing_CS), pointer :: tides_CSp !< A pointer to the control structure of the !! tide module. ! This include declares and sets the variable "version". @@ -4370,9 +4316,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%module_is_initialized = .true. CS%diag => diag ; CS%Time => Time - if (present(tides_CSp)) then - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp - endif + if (associated(tides_CSp)) CS%tides_CSp => tides_CSp ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "SPLIT", CS%split, default=.true., do_not_log=.true.) @@ -4986,7 +4930,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, enddo ; enddo endif - call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1) if ((CS%bound_BT_corr) .and. .not.(use_BT_Cont_type .and. CS%BT_cont_bounds)) then ! This is not used in most test cases. Were it ever to become more widely used, consider ! replacing maxvel with min(G%dxT(i,j),G%dyT(i,j)) * (CS%maxCFL_BT_cont*Idt) . diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 480568c545..655055b03d 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -39,7 +39,7 @@ module MOM_continuity !> Time steps the layer thicknesses, using a monotonically limited, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & +subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, & 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. @@ -60,14 +60,13 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume !! flux through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The vertically summed volume !! 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_(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 @@ -96,7 +95,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, " one must be present in call to continuity.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & + call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, OBC, uhbt, vhbt, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d8b6cddaaa..d30e1af0f2 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -73,11 +73,10 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, & 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_(GV)), & intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -91,15 +90,15 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. 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]. - type(ocean_OBC_type), & - optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally @@ -149,7 +148,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil - call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, OBC, uhbt, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -164,7 +163,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, OBC, vhbt, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -180,7 +179,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, OBC, vhbt, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -192,7 +191,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, OBC, uhbt, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -208,7 +207,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & +subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & 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. @@ -223,17 +222,16 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), & - optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. 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(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_(GV)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) @@ -272,7 +270,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then ; if (OBC%OBC_pe) then local_specified_BC = OBC%specified_u_BCs_exist_globally local_Flather_OBC = OBC%Flather_u_BCs_exist_globally local_open_BC = OBC%open_u_BCs_exist_globally @@ -293,7 +291,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & enddo ; enddo else call PPM_reconstruction_x(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, CS%simple_2nd, OBC) endif do I=ish-1,ieh ; visc_rem(I,k) = 1.0 ; enddo enddo @@ -484,7 +482,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then I = OBC%segment(n)%HI%IsdB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed + do j = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u @@ -492,7 +490,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 enddo else - do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed + do j = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*G%dy_Cu(I,j) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u @@ -508,10 +506,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, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) + CS%vol_CFL, CS%marginal_faces, OBC, visc_rem_u) else 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) + CS%vol_CFL, CS%marginal_faces, OBC, visc_rem_u) endif endif ; endif @@ -601,7 +599,7 @@ 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, GV, US, LB, vol_CFL, & - marginal, visc_rem_u, OBC) + marginal, OBC, visc_rem_u) 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_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -619,13 +617,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, 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. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. 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 !! barotropic acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -672,9 +670,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, endif local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then - local_open_BC = OBC%open_u_BCs_exist_globally - endif ; endif + if (associated(OBC)) local_open_BC = OBC%open_u_BCs_exist_globally if (local_open_BC) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then @@ -1022,12 +1018,12 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, 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, & +subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & 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_(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 + 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] @@ -1035,16 +1031,16 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & 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_OBC_type), pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. + 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_(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. Nondimensional between !! 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_(GV)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) @@ -1084,11 +1080,11 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then + if (associated(OBC)) then ; if (OBC%OBC_pe) then local_specified_BC = OBC%specified_v_BCs_exist_globally local_Flather_OBC = OBC%Flather_v_BCs_exist_globally local_open_BC = OBC%open_v_BCs_exist_globally - endif ; endif ; endif + endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = GV%ke CFL_dt = CS%CFL_limit_adjust / dt @@ -1105,7 +1101,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; enddo else call PPM_reconstruction_y(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, CS%simple_2nd, OBC) endif do i=ish,ieh ; visc_rem(i,k) = 1.0 ; enddo enddo @@ -1315,10 +1311,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, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) + CS%vol_CFL, CS%marginal_faces, OBC, visc_rem_v) else 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) + CS%vol_CFL, CS%marginal_faces, OBC, visc_rem_v) endif endif ; endif @@ -1412,7 +1408,7 @@ 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, GV, US, LB, vol_CFL, & - marginal, visc_rem_v, OBC) + marginal, OBC, visc_rem_v) 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]. @@ -1431,12 +1427,12 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, 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. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. 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. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -1485,9 +1481,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, endif local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then - local_open_BC = OBC%open_v_BCs_exist_globally - endif ; endif + if (associated(OBC)) local_open_BC = OBC%open_v_BCs_exist_globally if (local_open_BC) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_N_or_S) then @@ -1848,7 +1842,7 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. @@ -1861,9 +1855,9 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ type(OBC_segment_type), pointer :: segment => NULL() local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_BC = OBC%open_u_BCs_exist_globally - endif ; endif + endif isl = LB%ish-1 ; iel = LB%ieh+1 ; jsl = LB%jsh ; jel = LB%jeh @@ -1983,7 +1977,7 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. @@ -1996,9 +1990,9 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ type(OBC_segment_type), pointer :: segment => NULL() local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif isl = LB%ish ; iel = LB%ieh ; jsl = LB%jsh-1 ; jel = LB%jeh+1 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 0532aeac53..51f12329a5 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -563,8 +563,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, & - OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) + call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, CS%OBC, & + visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -581,12 +581,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the predictor step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & - u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & - G, GV, US, CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, ADp=CS%ADp, & - OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & - taux_bot=taux_bot, tauy_bot=tauy_bot, & - uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, u_av, v_av, & + CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, US, & + CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, CS%ADp, CS%OBC, CS%BT_cont, & + eta_PF_start, taux_bot, tauy_bot, uh_ptr, vh_ptr, u_ptr, v_ptr) if (showCallTree) call callTree_leave("btstep()") call cpu_clock_end(id_clock_btstep) @@ -650,8 +648,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & - CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & + call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, & + CS%uhbt, CS%vhbt, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") @@ -782,13 +780,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the corrector step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & - CS%eta_PF, u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, & - eta_pred, CS%uhbt, CS%vhbt, G, GV, US, CS%barotropic_CSp, & - CS%visc_rem_u, CS%visc_rem_v, etaav=eta_av, ADp=CS%ADp, & - OBC=CS%OBC, BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & - taux_bot=taux_bot, tauy_bot=tauy_bot, & - uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, u_av, v_av, & + CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, US, & + CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, CS%ADp, CS%OBC, CS%BT_cont, & + eta_PF_start, taux_bot, tauy_bot, uh_ptr, vh_ptr, u_ptr, v_ptr, etaav=eta_av) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo call cpu_clock_end(id_clock_btstep) @@ -856,8 +851,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & - CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) + call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, & + CS%uhbt, CS%vhbt, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids @@ -1272,8 +1267,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param !! diagnostic pointers type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields -! type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for -! !! the barotropic module type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields @@ -1286,7 +1279,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param !! the number of times the velocity is !! truncated (this should be 0). logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step - integer, optional, intent(out) :: cont_stencil !< The stencil for thickness + integer, intent(out) :: cont_stencil !< The stencil for thickness !! from the continuity solver. ! local variables @@ -1402,7 +1395,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param grain=CLOCK_ROUTINE) call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - if (present(cont_stencil)) cont_stencil = continuity_stencil(CS%continuity_CSp) + cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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, & @@ -1482,7 +1475,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) do k=1,nz ; do j=jsd,jed ; do i=isd,ied CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6f33a00768..48d767e1a8 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -265,7 +265,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -355,7 +355,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, CS%continuity_CSp, CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -415,7 +415,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(upp, vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(upp, vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, CS%continuity_CSp, CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -572,7 +572,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up !! by initialize_dyn_unsplit. type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !!structure. + !! structure. type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the various !! accelerations in the momentum equations, which can be used !! for later derived diagnostics, like energy budgets. @@ -601,7 +601,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS integer, target, intent(inout) :: ntrunc !< A target for the variable that !! records the number of times the velocity !! is truncated (this should be 0). - integer, optional, intent(out) :: cont_stencil !< The stencil for thickness + integer, intent(out) :: cont_stencil !< The stencil for thickness !! from the continuity solver. ! This subroutine initializes all of the variables that are used by this @@ -653,7 +653,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - if (present(cont_stencil)) cont_stencil = continuity_stencil(CS%continuity_CSp) + cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 18a192cb39..e6fec7f61e 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -281,7 +281,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_continuity) ! This is a duplicate calculation of the last continuity from the previous step ! and could/should be optimized out. -AJA - call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -350,7 +350,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -405,7 +405,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, h_in, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -547,7 +547,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag integer, target, intent(inout) :: ntrunc !< A target for the variable !! that records the number of times the !! velocity is truncated (this should be 0). - integer, optional, intent(out) :: cont_stencil !< The stencil for + integer, intent(out) :: cont_stencil !< The stencil for !! thickness from the continuity solver. ! This subroutine initializes all of the variables that are used by this @@ -615,7 +615,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - if (present(cont_stencil)) cont_stencil = continuity_stencil(CS%continuity_CSp) + cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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, & diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index f0b1158b22..1601d6dd56 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -160,7 +160,7 @@ module MOM_open_boundary integer :: zphase_index !< Save where zphase is in segment%field. real :: Velocity_nudging_timescale_in !< Nudging timescale on inflow [T ~> s]. real :: Velocity_nudging_timescale_out !< Nudging timescale on outflow [T ~> s]. - logical :: on_pe !< true if segment is located in the computational domain + logical :: on_pe !< true if any portion of the segment is located in this PE's data domain logical :: temp_segment_data_exists !< true if temperature data arrays are present logical :: salt_segment_data_exists !< true if salinity data arrays are present real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [L T-1 ~> m s-1] diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index a9626a805c..f176d6671c 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -170,7 +170,7 @@ end subroutine copy_dyngrid_to_MOM_grid subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) type(ocean_grid_type), intent(in) :: oG !< Ocean grid type type(dyn_horgrid_type), intent(inout) :: dG !< Common horizontal grid type - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -305,7 +305,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) call pass_vector(dG%Dopen_u, dG%Dopen_v, dG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_dyn_horgrid(dG, US) + call set_derived_dyn_horgrid(dG, US) end subroutine copy_MOM_grid_to_dyngrid From 39c0c3483d58572f35a73f6495374979aac465d2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 13 Oct 2021 10:19:43 -0400 Subject: [PATCH 013/138] Refactored solo_driver/MOM_driver.F90 Refactored solo_driver/MOM_driver.F90 to move logically self-contained blocks of code into separate subroutines within this file to improve the readability of the code and to reduce the number of global variables. This started out as an exercise to explore the use of the F2008 block / end block construct to reduce the scope of variables, but the code ended up being cleaner just using traditional subroutines contained in this file. All answers are bitwise identical and all output files are unaltered. --- config_src/drivers/solo_driver/MOM_driver.F90 | 190 ++++++++++-------- 1 file changed, 110 insertions(+), 80 deletions(-) diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 7dfce01f68..ebf3e5a43d 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -96,8 +96,6 @@ program MOM_main ! This is .true. if incremental restart files may be saved. logical :: permit_incr_restart = .true. - integer :: ns - ! nmax is the number of iterations after which to stop so that the ! simulation does not exceed its CPU time limit. nmax is determined by ! evaluating the CPU time used between successive calls to write_cputime. @@ -120,6 +118,7 @@ program MOM_main type(time_type) :: Time_end ! End time for the segment or experiment. type(time_type) :: restart_time ! The next time to write restart files. type(time_type) :: Time_step_ocean ! A time_type version of dt_forcing. + logical :: segment_start_time_set ! True if segment_start_time has been set to a valid value. real :: elapsed_time = 0.0 ! Elapsed time in this run [s]. logical :: elapsed_time_master ! If true, elapsed time is used to set the @@ -136,9 +135,9 @@ program MOM_main ! chosen so that dt_forcing is an integer multiple of dt_dyn. real :: dtdia ! The diabatic timestep [s] real :: t_elapsed_seg ! The elapsed time in this run segment [s] - integer :: n, n_max, nts, n_last_thermo + integer :: n, ns, n_max, nts, n_last_thermo logical :: diabatic_first, single_step_call - type(time_type) :: Time2, time_chg + type(time_type) :: Time2, time_chg ! Temporary time variables integer :: Restart_control ! An integer that is bit-tested to determine whether ! incremental restart files are saved and whether they @@ -152,23 +151,13 @@ program MOM_main type(time_type) :: daymax ! The final day of the simulation. integer :: CPU_steps ! The number of steps between writing CPU time. - integer :: date_init(6)=0 ! The start date of the whole simulation. - integer :: date(6)=-1 ! Possibly the start date of this run segment. - integer :: years=0, months=0, days=0 ! These may determine the segment run - integer :: hours=0, minutes=0, seconds=0 ! length, if read from a namelist. - integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date. + integer :: date(6) ! Possibly the start date of this run segment. type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. - character(len=9) :: month - character(len=16) :: calendar = 'julian' - integer :: calendar_type=-1 - integer :: unit, io_status, ierr - integer :: ensemble_size, nPEs_per, ensemble_info(6) + integer :: calendar_type=-1 ! A coded integer indicating the calendar type. - integer, dimension(0) :: atm_PElist, land_PElist, ice_PElist - integer, dimension(:), allocatable :: ocean_PElist - logical :: unit_in_use + integer :: unit, io_status, ierr integer :: initClock, mainClock, termClock logical :: debug ! If true, write verbose checksums for debugging purposes. @@ -180,7 +169,8 @@ program MOM_main ! and diffusion equation are read in from files stored from ! a previous integration of the prognostic model - type(MOM_control_struct) :: MOM_CSp !> MOM control structure + type(MOM_control_struct) :: MOM_CSp !< The control structure with all the MOM6 internal types, + !! parameters and variables type(tracer_flow_control_CS), pointer :: & tracer_flow_CSp => NULL() !< A pointer to the tracer flow control structure type(surface_forcing_CS), pointer :: surface_forcing_CSp => NULL() @@ -195,14 +185,18 @@ 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) :: mod_name = "MOM_main (MOM_driver)" ! This module's name. + ! These are the variables that might be read via the namelist capability. + integer :: date_init(6)=0 ! The start date of the whole simulation. + character(len=16) :: calendar = 'julian' ! The name of the calendar type. + integer :: years=0, months=0, days=0 ! These may determine the segment run + integer :: hours=0, minutes=0, seconds=0 ! length, if read from a namelist. integer :: ocean_nthreads = 1 logical :: use_hyper_thread = .false. - integer :: omp_get_num_threads,omp_get_thread_num - namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds,& + namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds, & ocean_nthreads, use_hyper_thread !===================================================================== @@ -213,18 +207,8 @@ program MOM_main !allocate(forces,fluxes,sfc_state) - ! Initialize the ensemble manager. If there are no settings for ensemble_size - ! in input.nml(ensemble.nml), these should not do anything. In coupled - ! configurations, this all occurs in the external driver. - call ensemble_manager_init() ; ensemble_info(:) = get_ensemble_size() - ensemble_size=ensemble_info(1) ; nPEs_per=ensemble_info(2) - if (ensemble_size > 1) then ! There are multiple ensemble members. - allocate(ocean_pelist(nPEs_per)) - call ensemble_pelist_setup(.true., 0, nPEs_per, 0, 0, atm_pelist, ocean_pelist, & - land_pelist, ice_pelist) - call Set_PElist(ocean_pelist) - deallocate(ocean_pelist) - endif + ! Initialize the ensemble manager based on settings in input.nml(ensemble.nml). + call initialize_ocean_only_ensembles() ! These clocks are on the global pelist. initClock = cpu_clock_id( 'Initialization' ) @@ -241,9 +225,7 @@ program MOM_main read(unit, ocean_solo_nml, iostat=io_status) call close_file(unit) ierr = check_nml_error(io_status,'ocean_solo_nml') - if (years+months+days+hours+minutes+seconds > 0) then - if (is_root_pe()) write(*,ocean_solo_nml) - endif + if (is_root_pe() .and. (years+months+days+hours+minutes+seconds > 0)) write(*,ocean_solo_nml) endif ! This call sets the number and affinity of threads with openMP. @@ -253,13 +235,22 @@ program MOM_main ! The contents of dirs will be reread in initialize_MOM. call get_MOM_input(dirs=dirs) + segment_start_time_set = .false. ! Read ocean_solo restart, which can override settings from the namelist. if (file_exists(trim(dirs%restart_input_dir)//'ocean_solo.res')) then + date(:) = -1 call open_ASCII_file(unit, trim(dirs%restart_input_dir)//'ocean_solo.res', action=READONLY_FILE) read(unit,*) calendar_type read(unit,*) date_init read(unit,*) date call close_file(unit) + + call set_calendar_type(calendar_type) + if (sum(date) >= 0) then + ! In this case, the segment starts at a time fixed by ocean_solo.res + segment_start_time = set_date(date(1), date(2), date(3), date(4), date(5), date(6)) + segment_start_time_set = .true. + endif else calendar = uppercase(calendar) if (calendar(1:6) == 'JULIAN') then ; calendar_type = JULIAN @@ -272,8 +263,8 @@ program MOM_main else call MOM_error(FATAL,'MOM_driver: No namelist value for calendar') endif + call set_calendar_type(calendar_type) endif - call set_calendar_type(calendar_type) if (sum(date_init) > 0) then @@ -285,23 +276,18 @@ program MOM_main call time_interp_external_init() - if (sum(date) >= 0) then - ! In this case, the segment starts at a time fixed by ocean_solo.res - segment_start_time = set_date(date(1), date(2), date(3), date(4), date(5), date(6)) - Time = segment_start_time - else - ! In this case, the segment starts at a time read from the MOM restart file - ! or left as Start_time by MOM_initialize. - Time = Start_time - endif - ! Call initialize MOM with an optional Ice Shelf CS which, if present triggers ! initialization of ice shelf parameters and arrays. - if (sum(date) >= 0) then + if (segment_start_time_set) then + ! In this case, the segment starts at a time fixed by ocean_solo.res + Time = segment_start_time call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & segment_start_time, offline_tracer_mode=offline_tracer_mode, & diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp) else + ! In this case, the segment starts at a time read from the MOM restart file + ! or is left at Start_time by MOM_initialize. + Time = Start_time call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & offline_tracer_mode=offline_tracer_mode, diag_ptr=diag, & tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp) @@ -328,7 +314,7 @@ program MOM_main call callTree_waypoint("done surface_forcing_init") - call get_param(param_file,mod_name, "USE_WAVES", Use_Waves, & + call get_param(param_file, mod_name, "USE_WAVES", Use_Waves, & "If true, enables surface wave modules.",default=.false.) ! MOM_wave_interface_init is called regardless of the value of USE_WAVES because ! it also initializes statistical waves. @@ -432,16 +418,7 @@ program MOM_main call diag_mediator_close_registration(diag) ! Write out a time stamp file. - if (is_root_pe() .and. (calendar_type /= NO_CALENDAR)) then - call open_ASCII_file(unit, 'time_stamp.out', action=APPEND_FILE) - call get_date(Time, date(1), date(2), date(3), date(4), date(5), date(6)) - month = month_name(date(2)) - write(unit,'(6i4,2x,a3)') date, month(1:3) - call get_date(Time_end, date(1), date(2), date(3), date(4), date(5), date(6)) - month = month_name(date(2)) - write(unit,'(6i4,2x,a3)') date, month(1:3) - call close_file(unit) - endif + if (is_root_pe() .and. (calendar_type /= NO_CALENDAR)) call write_time_stamp_file(Time) if (cpu_steps > 0) call write_cputime(Time, 0, write_CPU_CSp) @@ -616,34 +593,19 @@ program MOM_main call save_restart(dirs%restart_output_dir, Time, grid, restart_CSp, GV=GV) if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, & dirs%restart_output_dir) - ! Write ocean solo restart file. - if (is_root_pe()) then - call open_ASCII_file(unit, trim(dirs%restart_output_dir)//'ocean_solo.res') - write(unit, '(i6,8x,a)') calendar_type, & - '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - - call get_date(Start_time, yr, mon, day, hr, mins, sec) - write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & - 'Model start time: year, month, day, hour, minute, second' - call get_date(Time, yr, mon, day, hr, mins, sec) - write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & - 'Current model time: year, month, day, hour, minute, second' - call close_file(unit) - endif + ! Write the ocean solo restart file. + call write_ocean_solo_res(Time, Start_time, calendar_type, & + trim(dirs%restart_output_dir)//'ocean_solo.res') endif if (is_root_pe()) then - do unit=10,1967 - INQUIRE(unit,OPENED=unit_in_use) - if (.not.unit_in_use) exit - enddo - open(unit,FILE="exitcode",FORM="FORMATTED",STATUS="REPLACE",action="WRITE") + call open_ASCII_file(unit, "exitcode") if (Time < daymax) then write(unit,*) 9 else write(unit,*) 0 endif - close(unit) + call close_file(unit) endif call callTree_waypoint("End MOM_main") @@ -656,4 +618,72 @@ program MOM_main call MOM_end(MOM_CSp) +contains + +!> Write out the ocean solo restart file to the indicated path. +subroutine write_ocean_solo_res(Time, Start_time, calendar, file_path) + type(time_type), intent(in) :: Time !< The current model time. + type(time_type), intent(in) :: Start_Time !< The start time of the simulation. + integer, intent(in) :: calendar !< A coded integer indicating the calendar type. + character(len=*), intent(in) :: file_path !< The full path and name of the restart file + + ! Local variables + integer :: unit + integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date. + + if (.not.is_root_pe()) return + + call open_ASCII_file(unit, trim(file_path)) + write(unit, '(i6,8x,a)') calendar, & + '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' + + call get_date(Start_time, yr, mon, day, hr, mins, sec) + write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & + 'Model start time: year, month, day, hour, minute, second' + call get_date(Time, yr, mon, day, hr, mins, sec) + write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & + 'Current model time: year, month, day, hour, minute, second' + call close_file(unit) +end subroutine write_ocean_solo_res + + +!> Write out an ascii time stamp file with the model time, following FMS conventions. +subroutine write_time_stamp_file(Time) + type(time_type), intent(in) :: Time !< The current model time. + ! Local variables + integer :: unit + integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date. + character(len=9) :: month ! The name of the month + + if (.not.is_root_PE()) return + + call open_ASCII_file(unit, 'time_stamp.out', action=APPEND_FILE) + call get_date(Time, yr, mon, day, hr, mins, sec) + month = month_name(mon) + write(unit,'(6i4,2x,a3)') yr, mon, day, hr, mins, sec, month(1:3) + call get_date(Time_end, yr, mon, day, hr, mins, sec) + month = month_name(mon) + write(unit,'(6i4,2x,a3)') yr, mon, day, hr, mins, sec, month(1:3) + call close_file(unit) +end subroutine write_time_stamp_file + +!> Initialize the ensemble manager. If there are no settings for ensemble_size +!! in input.nml(ensemble.nml), these should not do anything. In coupled +!! configurations, this all occurs in the external driver. +subroutine initialize_ocean_only_ensembles() + integer, dimension(:), allocatable :: ocean_PElist + integer, dimension(0) :: atm_PElist, land_PElist, ice_PElist + integer :: ensemble_size, nPEs_per, ensemble_info(6) + + call ensemble_manager_init() ; ensemble_info(:) = get_ensemble_size() + ensemble_size = ensemble_info(1) ; nPEs_per = ensemble_info(2) + if (ensemble_size > 1) then ! There are multiple ensemble members. + allocate(ocean_pelist(nPEs_per)) + call ensemble_pelist_setup(.true., 0, nPEs_per, 0, 0, atm_pelist, ocean_pelist, & + land_pelist, ice_pelist) + call Set_PElist(ocean_pelist) + deallocate(ocean_pelist) + endif +end subroutine initialize_ocean_only_ensembles + end program MOM_main From c62258c9d2337f6002cf31681af901fb6fb219dc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 17 Oct 2021 07:47:13 -0400 Subject: [PATCH 014/138] +Optional just_read_params args are now mandatory Made 44 previously optional just_read_params arguments into mandatory arguments and renamed them just_read to avoid duplicated variables. This change should be minimally disruptive, as these optional arguments were always being provided. Some argument documentation blocks were also reformatted or the comments in them were corrected. All answers are bitwise identical, but some arguments have changed. --- .../MOM_state_initialization.F90 | 219 +++++++----------- src/user/DOME2d_initialization.F90 | 22 +- src/user/DOME_initialization.F90 | 15 +- src/user/ISOMIP_initialization.F90 | 22 +- src/user/Phillips_initialization.F90 | 18 +- src/user/Rossby_front_2d_initialization.F90 | 25 +- src/user/SCM_CVMix_tests.F90 | 10 +- src/user/adjustment_initialization.F90 | 26 +-- src/user/baroclinic_zone_initialization.F90 | 40 ++-- src/user/benchmark_initialization.F90 | 19 +- src/user/circle_obcs_initialization.F90 | 9 +- src/user/dense_water_initialization.F90 | 9 +- src/user/dumbbell_initialization.F90 | 18 +- src/user/external_gwave_initialization.F90 | 13 +- src/user/lock_exchange_initialization.F90 | 13 +- src/user/seamount_initialization.F90 | 20 +- src/user/sloshing_initialization.F90 | 17 +- src/user/user_initialization.F90 | 30 +-- 18 files changed, 209 insertions(+), 336 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 641b2ae382..9b9fdac145 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -257,7 +257,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true") call MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, & - just_read_params=just_read, frac_shelf_h=frac_shelf_h) + just_read=just_read, frac_shelf_h=frac_shelf_h) else ! Initialize thickness, h. call get_param(PF, mdl, "THICKNESS_CONFIG", config, & @@ -290,9 +290,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & default="uniform", do_not_log=just_read) select case (trim(config)) case ("file") - call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .false., just_read_params=just_read) + call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .false., just_read=just_read) case ("thickness_file") - call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .true., just_read_params=just_read) + call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .true., just_read=just_read) case ("coord") if (new_sim .and. useALE) then call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) @@ -301,41 +301,41 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "for THICKNESS_CONFIG of 'coord'") endif case ("uniform"); call initialize_thickness_uniform(h, depth_tot, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("list"); call initialize_thickness_list(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("DOME"); call DOME_initialize_thickness(h, depth_tot, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("ISOMIP"); call ISOMIP_initialize_thickness(h, depth_tot, G, GV, US, PF, tv, & - just_read_params=just_read) + just_read=just_read) case ("benchmark"); call benchmark_initialize_thickness(h, depth_tot, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) + tv%eqn_of_state, tv%P_Ref, just_read=just_read) case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, depth_tot, G, GV, US, PF, & tv%eqn_of_state, tv%P_Ref) case ("search"); call initialize_thickness_search() case ("circle_obcs"); call circle_obcs_initialize_thickness(h, depth_tot, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("DOME2D"); call DOME2d_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("sloshing"); call sloshing_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("seamount"); call seamount_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("dumbbell"); call dumbbell_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("soliton"); call soliton_initialize_thickness(h, depth_tot, G, GV, US) case ("phillips"); call Phillips_initialize_thickness(h, depth_tot, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, US, & - PF, just_read_params=just_read) + PF, just_read=just_read) case ("USER"); call user_initialize_thickness(h, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized layer thickness configuration "//trim(config)) end select @@ -366,37 +366,37 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& 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) + eos, tv%P_Ref, just_read=just_read) case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, GV, & - PF, just_read_params=just_read) + PF, just_read=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) + G, GV, US, PF, eos, tv%P_Ref, just_read=just_read) case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & - G, GV, PF, just_read_params=just_read) + G, GV, PF, just_read=just_read) case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, eos, just_read=just_read) case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, US, PF, eos, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, US, PF, eos, just_read=just_read) case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, PF, eos, just_read=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & - tv%S, h, depth_tot, G, GV, US, PF, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, US, PF, just_read=just_read) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, eos, just_read=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, eos, just_read=just_read) case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, eos, just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, G, GV, PF, eos, just_read=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, h, & - G, GV, US, PF, just_read_params=just_read) + G, GV, US, PF, just_read=just_read) case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & - h, just_read_params=just_read) + h, just_read=just_read) case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, eos, & - just_read_params=just_read) + just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized Temp & salt configuration "//trim(config)) end select @@ -423,20 +423,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & do_not_log=just_read) select case (trim(config)) case ("file"); call initialize_velocity_from_file(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("zero"); call initialize_velocity_zero(u, v, G, GV, PF, & - just_read_params=just_read) + just_read=just_read) case ("uniform"); call initialize_velocity_uniform(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("circular"); call initialize_velocity_circular(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & - G, GV, US, PF, just_read_params=just_read) + G, GV, US, PF, just_read=just_read) case ("soliton"); call soliton_initialize_velocity(u, v, h, G, GV, US) case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, & - just_read_params=just_read) + just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) end select @@ -472,8 +472,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m) - if (depress_sfc) call depress_surface(h, G, GV, US, PF, tv, just_read_params=just_read) - if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params=just_read) + if (depress_sfc) call depress_surface(h, G, GV, US, PF, tv, just_read=just_read) + if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read=just_read) ! Perhaps we want to run the regridding coordinate generator for multiple ! iterations here so the initial grid is consistent with the coordinate @@ -659,7 +659,7 @@ end subroutine MOM_initialize_state !> Reads the layer thicknesses or interface heights from a file. subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, file_has_thickness, & - just_read_params) + just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -672,22 +672,19 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f logical, intent(in) :: file_has_thickness !< If true, this file contains layer !! thicknesses; otherwise it contains !! interface heights. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units [Z ~> m]. integer :: inconsistent = 0 logical :: correct_thickness - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -832,7 +829,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta) end subroutine adjustEtaToFitBathymetry !> Initializes thickness to be uniform -subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_read_params) +subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -841,21 +838,18 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units, usually ! negative because it is positive upward. 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -889,33 +883,30 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re end subroutine initialize_thickness_uniform !> Initialize thickness from a 1D list -subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. 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]. - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "INTERFACE_IC_FILE", eta_file, & "The file from which horizontal mean initial conditions "//& "for interface depths can be read.", fail_if_missing=.true.) @@ -1047,7 +1038,7 @@ subroutine convert_thickness(h, G, GV, US, tv) end subroutine convert_thickness !> Depress the sea-surface based on an initial condition file -subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) +subroutine depress_surface(h, G, GV, US, param_file, tv, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1055,8 +1046,8 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) 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 - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & eta_sfc ! The free surface height that the model should use [Z ~> m]. @@ -1068,11 +1059,9 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) character(len=40) :: mdl = "depress_surface" ! This subroutine's name. character(len=200) :: inputdir, eta_srf_file ! Strings for file/path character(len=200) :: filename, eta_srf_var ! Strings for file/path - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Read the surface height (or pressure) from a file. @@ -1131,7 +1120,7 @@ end subroutine depress_surface !> Adjust the layer thicknesses by cutting away the top of each model column at the depth !! where the hydrostatic pressure matches an imposed surface pressure read from file. -subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) +subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) type(param_file_type), intent(in) :: PF !< Parameter file structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -1140,8 +1129,8 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure 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. + logical, intent(in) :: just_read !< If 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] @@ -1152,12 +1141,9 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. integer :: i, j, k logical :: default_2018_answers, remap_answers_2018 - logical :: just_read ! If true, just read parameters but set nothing. logical :: use_remapping ! If true, remap the initial conditions. type(remapping_CS), pointer :: remap_CS => NULL() - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(PF, mdl, "SURFACE_PRESSURE_FILE", p_surf_file, & "The initial condition file for the surface pressure exerted by ice.", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -1321,7 +1307,7 @@ 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, GV, US, param_file, just_read_params) +subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1331,14 +1317,11 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read_ 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. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing u or v. ! Local variables character(len=40) :: mdl = "initialize_velocity_from_file" ! This subroutine's name. character(len=200) :: filename,velocity_file,inputdir ! Strings for file/path - logical :: just_read ! If true, just read parameters but set nothing. - - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -1363,7 +1346,7 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read_ end subroutine initialize_velocity_from_file !> Initialize horizontal velocity components to zero. -subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read_params) +subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1372,17 +1355,15 @@ subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read_params) 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. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables 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 = 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 - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") if (just_read) return ! All run-time parameters have been read, so return. @@ -1398,7 +1379,7 @@ subroutine initialize_velocity_zero(u, v, G, GV, param_file, just_read_params) end subroutine initialize_velocity_zero !> Sets the initial velocity components to uniform -subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read_params) +subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1408,18 +1389,16 @@ subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read_pa 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. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing u or v. ! Local variables integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real :: initial_u_const, initial_v_const - 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 = 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 - call get_param(param_file, mdl, "INITIAL_U_CONST", initial_u_const, & "A initial uniform value for the zonal flow.", & default=0.0, units="m s-1", scale=US%m_s_to_L_T, do_not_log=just_read) @@ -1440,7 +1419,7 @@ 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, GV, US, param_file, just_read_params) +subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -1450,20 +1429,17 @@ subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read_p 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 u or v. + logical, intent(in) :: just_read !< If true, this call will 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] real :: dpi ! A local variable storing pi = 3.14159265358979... 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 = 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 - call get_param(param_file, mdl, "CIRCULAR_MAX_U", circular_max_u, & "The amplitude of zonal flow from which to scale the "// & "circular stream function [m s-1].", & @@ -1504,25 +1480,22 @@ end function my_psi end subroutine initialize_velocity_circular !> Initializes temperature and salinity from file -subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read_params) +subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The 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. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + logical, intent(in) :: just_read !< If true, this call will 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 character(len=200) :: ts_file, salt_file, inputdir ! Strings for file/path character(len=40) :: mdl = "initialize_temp_salt_from_file" character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "TS_FILE", ts_file, & @@ -1561,7 +1534,7 @@ subroutine initialize_temp_salt_from_file(T, S, G, GV, param_file, just_read_par end subroutine initialize_temp_salt_from_file !> Initializes temperature and salinity from a 1D profile -subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read_params) +subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is @@ -1569,17 +1542,14 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read_ 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. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T or S. ! Local variables real, dimension(SZK_(GV)) :: T0, S0 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 character(len=40) :: mdl = "initialize_temp_salt_from_profile" - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "TS_FILE", ts_file, & @@ -1607,7 +1577,7 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, param_file, just_read_ end subroutine initialize_temp_salt_from_profile !> Initializes temperature and salinity by fitting to density -subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P_Ref, just_read_params) +subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P_Ref, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is @@ -1620,8 +1590,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T or S. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T or S. ! Local variables real :: T0(SZK_(GV)) ! Layer potential temperatures [degC] real :: S0(SZK_(GV)) ! Layer salinities [degC] @@ -1632,13 +1602,10 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "T_REF", T_Ref, & @@ -1701,7 +1668,7 @@ 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, GV, param_file, just_read_params) +subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature that is @@ -1710,7 +1677,7 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read_params !! 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, + logical, intent(in) :: just_read !< If present and true, !! this call will only read parameters !! without changing T or S. @@ -1719,11 +1686,8 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, param_file, just_read_params real :: S_top, T_top ! Reference salinity and temperature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical real :: delta - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's name. - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "T_TOP", T_top, & "Initial temperature of the top surface.", & @@ -2283,7 +2247,7 @@ end subroutine set_velocity_depth_min !> This subroutine determines the isopycnal or other coordinate interfaces and !! layer potential temperatures and salinities directly from a z-space file on !! a latitude-longitude grid. -subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just_read_params, frac_shelf_h) +subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just_read, frac_shelf_h) 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)), & @@ -2295,8 +2259,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just 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 T or S. + logical, intent(in) :: just_read !< If true, this call will 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]. @@ -2340,7 +2304,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just character(len=8) :: laynum integer, parameter :: niter=10 ! number of iterations for t/s adjustment to layer density - logical :: just_read ! If true, just read parameters but set nothing. logical :: adjust_temperature = .true. ! fit t/s to target densities real, parameter :: missing_value = -1.e20 real, parameter :: temp_land_fill = 0.0, salt_land_fill = 35.0 @@ -2393,8 +2356,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just PI_180=atan(1.0)/45. - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") if (.not.just_read) call log_version(PF, mdl, version, "") diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index f99f0b8d5c..bc689b112e 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -90,18 +90,18 @@ subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) end subroutine DOME2d_initialize_topography !> Initialize thicknesses according to coordinate mode -subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params ) +subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read ) 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(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: e0(SZK_(GV)) ! The resting interface heights, in depth units [Z ~> m], usually @@ -113,13 +113,10 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju real :: delta_h real :: min_thickness real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") @@ -224,7 +221,7 @@ end subroutine DOME2d_initialize_thickness !> Initialize temperature and salinity in the 2d DOME configuration subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) + eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] @@ -232,7 +229,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, 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 + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables @@ -240,17 +237,14 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, real :: x integer :: index_bay_z real :: delta_S, delta_T - real :: S_ref, T_ref; ! Reference salinity and temperature within surface layer - real :: S_range, T_range; ! Range of salinities and temperatures over the vertical + real :: S_ref, T_ref ! Reference salinity and temperature within surface layer + real :: S_range, T_range ! Range of salinities and temperatures over the vertical real :: xi0, xi1 - logical :: just_read ! If true, just read parameters but set nothing. 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 1f3d24e1c9..8599272e32 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -87,7 +87,7 @@ end subroutine DOME_initialize_topography ! ----------------------------------------------------------------------------- !> This subroutine initializes layer thicknesses for the DOME experiment -subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_params) +subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -96,21 +96,18 @@ subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_ intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. - logical :: just_read ! If true, just read parameters but set nothing. 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. call MOM_mesg(" DOME_initialization.F90, DOME_initialize_thickness: setting thickness", 5) @@ -149,8 +146,8 @@ end subroutine DOME_initialize_thickness !! the first registered field. ! subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) 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(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields, including potential temperature and !! salinity or mixed layer density. Absent fields have NULL ptrs. @@ -250,7 +247,7 @@ end subroutine DOME_initialize_sponges subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ocean_OBC_type), pointer :: OBC !< OBC registry. + type(ocean_OBC_type), pointer :: OBC !< OBC registry. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. if (OBC%number_of_segments /= 1) then diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 76f60d9b99..580fab1ac6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -51,9 +51,9 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) real :: min_depth ! The minimum and maximum depths [Z ~> m]. real :: m_to_Z ! A dimensional rescaling factor. ! The following variables are used to set up the bathymetry in the ISOMIP example. - real :: bmax ! max depth of bedrock topography - real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeff - real :: xbar ! characteristic along-flow lenght scale of the bedrock + real :: bmax ! max depth of bedrock topography [Z ~> m] + real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] + real :: xbar ! characteristic along-flow length scale of the bedrock real :: dc ! depth of the trough compared with side walls [Z ~> m]. real :: fc ! characteristic width of the side walls of the channel real :: wc ! half-width of the trough @@ -128,7 +128,7 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) end subroutine ISOMIP_initialize_topography !> Initialization of thicknesses -subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv, just_read_params) +subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -141,8 +141,8 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields, including !! the eqn. of state. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. @@ -153,14 +153,11 @@ subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv real :: min_thickness, s_sur, s_bot, t_sur, t_bot real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: rho_range ! The range of densities [R ~> kg m-3] - logical :: just_read ! If true, just read parameters but set nothing. 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") @@ -251,7 +248,7 @@ end subroutine ISOMIP_initialize_thickness !> Initial values for temperature and salinity subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, US, param_file, & - eqn_of_state, just_read_params) + eqn_of_state, just_read) 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 @@ -262,7 +259,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U !! depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt @@ -277,7 +274,6 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile 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_(GV)) ! A profile of temperatures [degC] real :: S0(SZK_(GV)) ! A profile of salinities [ppt] @@ -291,8 +287,6 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U 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 - call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_T_SUR",t_sur, & diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 448c86b5fb..a2dd76519d 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -35,7 +35,7 @@ module Phillips_initialization contains !> Initialize the thickness field for the Phillips model test case. -subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -45,8 +45,8 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. 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] @@ -56,7 +56,6 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju real :: y_2 ! The y-position relative to the center of the domain [km] real :: half_strat ! The fractional depth where the stratification is centered [nondim] real :: half_depth ! The depth where the stratification is centered [Z ~> m] - logical :: just_read ! If true, just read parameters but set nothing. logical :: reentrant_y ! If true, model is re-entrant in the y direction character(len=40) :: mdl = "Phillips_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -67,8 +66,6 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju eta_im(:,:) = 0.0 - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The fractional depth where the stratification is centered.", & @@ -130,7 +127,7 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju end subroutine Phillips_initialize_thickness !> Initialize the velocity fields for the Phillips model test case -subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) +subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -140,8 +137,8 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p 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 modelparameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing u & v. 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] @@ -150,13 +147,10 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p real :: velocity_amplitude ! The amplitude of velocity perturbations [L T-1 ~> m s-1] real :: pi ! The ratio of the circumference of a circle to its diameter [nondim] integer :: i, j, k, is, ie, js, je, nz, m - logical :: just_read ! If true, just read parameters but set nothing. logical :: reentrant_y ! If true, model is re-entrant in the y direction character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. 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) call get_param(param_file, mdl, "VELOCITY_IC_PERTURB_AMP", velocity_amplitude, & "The magnitude of the initial velocity perturbation.", & diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index cd87b47621..d7af8af0e4 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -36,7 +36,7 @@ module Rossby_front_2d_initialization contains !> Initialization of thicknesses in 2D Rossby front test -subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read_params) +subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read) 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 @@ -44,20 +44,17 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read 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. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. integer :: i, j, k, is, ie, js, je, nz real :: Tz, Dml, eta, stretch, h0 real :: min_thickness, T_range real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("Rossby_front_2d_initialization.F90, Rossby_front_initialize_thickness: setting thickness") @@ -110,7 +107,7 @@ end subroutine Rossby_front_initialize_thickness !> Initialization of temperature and salinity in the Rossby front test subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & - param_file, eqn_of_state, just_read_params) + param_file, eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] @@ -118,21 +115,18 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & 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 + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: T_ref, S_ref ! Reference salinity and temerature within surface layer real :: T_range ! Range of salinities and temperatures over the vertical real :: y, zc, zi, dTdz - logical :: just_read ! If true, just read parameters but set nothing. 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & @@ -162,7 +156,7 @@ end subroutine Rossby_front_initialize_temperature_salinity !> Initialization of u and v in the Rossby front test -subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) +subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -174,8 +168,8 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just 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 setting u & v. + logical, intent(in) :: just_read !< If present and true, this call will only + !! read parameters without setting u & v. real :: y ! Non-dimensional coordinate across channel, 0..pi real :: T_range ! Range of salinities and temperatures over the vertical @@ -186,13 +180,10 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just real :: Ty ! The meridional temperature gradient [degC L-1 ~> degC m-1] real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 1d426be636..261a01ab03 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -52,7 +52,7 @@ module SCM_CVMix_tests contains !> Initializes temperature and salinity for the SCM CVMix test example -subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_params) +subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] @@ -60,8 +60,8 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure - logical, optional, intent(in) :: just_read_params !< If present and true, this call - !! will only read parameters without changing h. + logical, intent(in) :: just_read !< If present and true, this call + !! will only read parameters without changing T & S. ! Local variables real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness [Z ~> m]. real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness [Z ~> m]. @@ -73,15 +73,11 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par real :: LowerLayerdSdz !< Salt gradient in lower layer [ppt / Z ~> ppt m-1]. real :: LowerLayerMinTemp !< Minimum temperature in lower layer [degC] real :: zC, DZ, top, bottom ! Depths and thicknesses [Z ~> m]. - 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 = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "SCM_TEMP_MLD", UpperLayerTempMLD, & 'Initial temp mixed layer depth', & diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index b9f676dc55..c39561513c 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -32,7 +32,7 @@ module adjustment_initialization contains !> Initializes the layer thicknesses in the adjustment test case -subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read_params) +subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -40,8 +40,8 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read 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. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. @@ -55,7 +55,6 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read real :: adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] - 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" @@ -63,8 +62,6 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("initialize_thickness_uniform: setting thickness") @@ -194,19 +191,19 @@ end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, & - eqn_of_state, just_read_params) + eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized. 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]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to - !! parse for model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T & S. + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for model parameter values. + type(EOS_type), pointer :: eqn_of_state !< Equation of state. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: x, y, yy @@ -219,13 +216,10 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, real :: adjustment_width, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - ! Parameters used by main model initialization call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', do_not_log=just_read) diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 22f4d705a1..1555f4ecad 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -28,10 +28,10 @@ module baroclinic_zone_initialization !> Reads the parameters unique to this module subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & - delta_T, dTdx, L_zone, just_read_params) + delta_T, dTdx, L_zone, just_read) 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle real, intent(out) :: S_ref !< Reference salinity [ppt] real, intent(out) :: dSdz !< Salinity stratification [ppt Z-1 ~> ppt m-1] @@ -42,13 +42,9 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [degC] real, intent(out) :: dTdx !< Linear temperature gradient in [degC G%x_axis_units-1] real, intent(out) :: L_zone !< Width of baroclinic zone in [G%x_axis_units] - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. - logical :: just_read ! If true, just read parameters but set nothing. - - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call log_version(param_file, mdl, version, 'Initialization of an analytic baroclinic zone') call openParameterBlock(param_file,'BCZIC') @@ -76,18 +72,22 @@ end subroutine bcz_params !> Initialization of temperature and salinity with the baroclinic zone initial conditions subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, US, param_file, & - just_read_params) - 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_(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] + just_read) + 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_(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] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] - type(param_file_type), intent(in) :: param_file !< Parameter file handle - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing T & S. + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution @@ -96,13 +96,11 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, real :: zc, zi ! Depths in depth units [Z ~> m] real :: x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) - logical :: just_read ! If true, just read parameters but set nothing. 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, & - delta_T, dTdx, L_zone, just_read_params) + delta_T, dTdx, L_zone, just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index d077e0fa6f..e0dc87c96e 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -83,20 +83,20 @@ end subroutine benchmark_initialize_topography !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, eqn_of_state, & - P_Ref, just_read_params) + P_Ref, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. ! Local variables real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], @@ -122,7 +122,6 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e real :: err, derr_dz ! The error between the profile's temperature and the ! interface temperature for a given z and its derivative. real :: pi, z - logical :: just_read ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "benchmark_initialize_thickness" ! This subroutine's name. @@ -130,7 +129,6 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e 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, "") call get_param(param_file, mdl, "BENCHMARK_ML_DEPTH_IC", ML_depth, & "Initial mixed layer depth in the benchmark test case.", & @@ -215,7 +213,7 @@ end subroutine benchmark_initialize_thickness !> Initializes layer temperatures and salinities for benchmark subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & - eqn_of_state, P_Ref, just_read_params) + eqn_of_state, P_Ref, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The potential temperature @@ -229,8 +227,8 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. ! Local variables real :: T0(SZK_(GV)) ! A profile of temperatures [degC] real :: S0(SZK_(GV)) ! A profile of salinities [ppt] @@ -241,14 +239,11 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & real :: PI ! 3.1415926... calculated as 4*atan(1) real :: SST ! The initial sea surface temperature [degC]. real :: lat - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. k1 = GV%nk_rho_varies + 1 diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 29fb6647b3..3bfdeaa0ff 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -28,7 +28,7 @@ module circle_obcs_initialization contains !> This subroutine initializes layer thicknesses for the circle_obcs experiment. -subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_params) +subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -37,8 +37,8 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. @@ -46,7 +46,6 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus ! positive upward, in depth units [Z ~> m]. real :: IC_amp ! The amplitude of the initial height displacement [H ~> m or kg m-2]. real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset - logical :: just_read ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "circle_obcs_initialization" ! This module's name. @@ -54,8 +53,6 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus 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 MOM_mesg(" circle_obcs_initialization.F90, circle_obcs_initialize_thickness: setting thickness", 5) diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index c1eb4fa2e7..9169b27a06 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -95,7 +95,7 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) end subroutine dense_water_initialize_topography !> Initialize the temperature and salinity for the dense water experiment -subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, just_read_params) +subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, just_read) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure @@ -103,18 +103,15 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing T & S. ! Local variables real :: mld, S_ref, S_range, T_ref real :: zi, zmid - logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, nz nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, & "Depth of unstratified mixed layer as a fraction of the water column.", & units="nondim", default=default_mld, do_not_log=just_read) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 463fe018b0..6bc3dd67af 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -90,18 +90,18 @@ subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) end subroutine dumbbell_initialize_topography !> Initializes the layer thicknesses to be uniform in the dumbbell test case -subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. @@ -113,13 +113,10 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ! This include declares and sets the variable "version". # include "version_variable.h" character(len=20) :: verticalCoordinate - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") @@ -210,7 +207,7 @@ end subroutine dumbbell_initialize_thickness !> Initial values for temperature and salinity for the dumbbell test case subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) + eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] @@ -218,7 +215,7 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file 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 + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. ! Local variables @@ -226,14 +223,11 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file real :: xi0, xi1, dxi, r, S_surf, T_surf, S_range, T_range real :: x, y, dblen real :: T_ref, T_Light, T_Dense, S_ref, S_Light, S_Dense, a1, frac_dense, k_frac, res_rat - logical :: just_read ! If true, just read parameters but set nothing. 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - T_surf = 20.0 call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 9da82cb721..27d0cedded 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -25,7 +25,7 @@ module external_gwave_initialization contains !> This subroutine initializes layer thicknesses for the external_gwave experiment. -subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_read_params) +subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -33,24 +33,21 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re 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. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables 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". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg(" external_gwave_initialization.F90, external_gwave_initialize_thickness: setting thickness", 5) diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index d56605aa63..a61d07fcc8 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -23,7 +23,7 @@ module lock_exchange_initialization !> This subroutine initializes layer thicknesses for the lock_exchange experiment. ! ----------------------------------------------------------------------------- -subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_read_params) +subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -31,8 +31,8 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea 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. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. @@ -41,16 +41,13 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea ! positive upward [Z ~> m]. real :: front_displacement ! Vertical displacement acrodd front real :: thermocline_thickness ! Thickness of stratified region - logical :: just_read ! If true, just read parameters but set nothing. -! 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 = "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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg(" lock_exchange_initialization.F90, lock_exchange_initialize_thickness: setting thickness", 5) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 6bfaedc221..20e42de41b 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -77,18 +77,18 @@ end subroutine seamount_initialize_topography !> Initialization of thicknesses. !! This subroutine initializes the layer thicknesses to be uniform. -subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. @@ -97,13 +97,10 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j 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]. character(len=20) :: verticalCoordinate - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") @@ -193,7 +190,7 @@ end subroutine seamount_initialize_thickness !> Initial values for temperature and salinity subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) + eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] @@ -201,20 +198,17 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file 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 - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing T & S. ! Local variables integer :: i, j, k, is, ie, js, je, nz, k_light real :: xi0, xi1, dxi, r, S_surf, T_surf, S_range, T_range real :: T_ref, T_Light, T_Dense, S_ref, S_Light, S_Dense, a1, frac_dense, k_frac, res_rat - 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 = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl,"INITIAL_DENSITY_PROFILE", density_profile, & diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 1c3334d8b0..0c1cf59df8 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -53,17 +53,17 @@ end subroutine sloshing_initialize_topography !! same thickness but all interfaces (except bottom and sea surface) are !! displaced according to a half-period cosine, with maximum value on the !! left and minimum value on the right. This sets off a regular sloshing motion. -subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params) +subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. real :: displ(SZK_(GV)+1) ! The interface displacement [Z ~> m]. @@ -74,7 +74,6 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, real :: x1, y1, x2, y2 ! Dimensonless parameters. real :: x, t ! Dimensionless depth coordinates? logical :: use_IC_bug ! If true, set the initial conditions retaining an old bug. - logical :: just_read ! If true, just read parameters but set nothing. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "sloshing_initialization" !< This module's name. @@ -83,7 +82,6 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SLOSHING_IC_AMPLITUDE", a0, & "Initial amplitude of sloshing internal interface height "//& @@ -179,7 +177,7 @@ end subroutine sloshing_initialize_thickness !! Note that the linear distribution is set up with respect to the layer !! number, not the physical position). subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) + eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. @@ -189,8 +187,8 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file !! open file to parse for model !! parameter values. 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 - !! only read parameters without changing h. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz real :: delta_S, delta_T @@ -201,14 +199,11 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file integer :: kdelta real :: deltah real :: xi0, xi1 - logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's ! name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl, "S_REF", S_ref, 'Reference value for salinity', & default=35.0, units='1e-3', do_not_log=just_read) call get_param(param_file, mdl, "T_REF", T_ref, 'Reference value for temperature', & diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 3338121d9e..915be87e8a 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -78,24 +78,20 @@ subroutine USER_initialize_topography(D, G, param_file, max_depth, US) end subroutine USER_initialize_topography !> initialize thicknesses. -subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) +subroutine USER_initialize_thickness(h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thicknesses being initialized [H ~> m or kg m-2]. 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 + logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. - logical :: just_read ! If true, just read parameters but set nothing. - call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_thickness: " // & "Unmodified user routine called - you must edit the routine to use it") - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. h(:,:,1) = 0.0 ! h should be set [H ~> m or kg m-2]. @@ -105,7 +101,7 @@ 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, GV, US, param_file, just_read_params) +subroutine USER_initialize_velocity(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] @@ -114,17 +110,13 @@ subroutine USER_initialize_velocity(u, v, G, GV, US, param_file, just_read_param 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. - - logical :: just_read ! If true, just read parameters but set nothing. + logical, intent(in) :: just_read !< If true, this call will + !! only read parameters without changing u & v. call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_velocity: " // & "Unmodified user routine called - you must edit the routine to use it") - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. u(:,:,1) = 0.0 @@ -136,7 +128,7 @@ end subroutine USER_initialize_velocity !> This function puts the initial layer temperatures and salinities !! into T(:,:,:) and S(:,:,:). -subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, just_read_params) +subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. @@ -145,17 +137,13 @@ subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, !! open file to parse for model !! parameter values. 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 only + logical, intent(in) :: just_read !< If true, this call will only !! read parameters without changing T & S. - logical :: just_read ! If true, just read parameters but set nothing. - call MOM_error(FATAL, & "USER_initialization.F90, USER_init_temperature_salinity: " // & "Unmodified user routine called - you must edit the routine to use it") - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! All run-time parameters have been read, so return. T(:,:,1) = 0.0 @@ -229,8 +217,8 @@ subroutine write_user_log(param_file) !! open file to parse for model !! parameter values. -! 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 = "user_initialization" ! This module's name. call log_version(param_file, mdl, version) From 037af8ec782fead0f7aebff60a5a9e4406930d55 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 17 Oct 2021 15:28:58 -0400 Subject: [PATCH 015/138] +Argument cleanup in vertical parameterization code Cleaned up 27 falsely optional or unused arguments in the vertical parameterization code, and related changes. This includes: - Eliminating the symmetrize arguments to set_viscous_BBL and set_viscous_ML, which are now effectively always true. - Making the Waves and OBC pointer arguments mandatory in several routines where they were always being supplied. These are pointers, so the test of whether they should be used can be based on whether they are associated. - Adding error messages about unassociated Waves types that would be used. - Eliminating the unused Waves argument to KPP_init. - Eliminating unused arguments that energetic_PBL inherited from the bulk mixed layer code, and simplified some disabled debugging code. - Making the optics argument to opacity_end mandatory. - Making the h argument to get_Langmuir_Number mandatory and rearranged the arguments to this routine to put the optional arguments last, following the practice elsewhere in the MOM6 code. Also standardized the case of several variables in the MOM_wave_interface.F90 code to facilitate searches. - Eliminating the unused US argument to CoriolisStokes. All answers are bitwise identical, and no output is changed. --- src/core/MOM.F90 | 7 +- src/core/MOM_dynamics_split_RK2.F90 | 3 +- .../vertical/MOM_CVMix_KPP.F90 | 28 ++- .../vertical/MOM_diabatic_driver.F90 | 10 +- .../vertical/MOM_energetic_PBL.F90 | 225 +++++++----------- .../vertical/MOM_opacity.F90 | 8 +- .../vertical/MOM_set_diffusivity.F90 | 6 +- .../vertical/MOM_set_viscosity.F90 | 22 +- src/user/MOM_wave_interface.F90 | 93 ++++---- 9 files changed, 162 insertions(+), 240 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e8c770d247..fd798076fa 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1053,8 +1053,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(US%T_to_s*(bbl_time_int-dt)), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, & - CS%set_visc_CSp, symmetrize=.true.) + call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, CS%set_visc_CSp) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") call disable_averaging(CS%diag) @@ -1332,7 +1331,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics ! and set_viscous_BBL is called as a part of the dynamic stepping. call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp, symmetrize=.true.) + call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)") endif @@ -1353,7 +1352,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%OBC, Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 51f12329a5..f9d70d65d7 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -527,8 +527,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo call enable_averages(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & - CS%set_visc_CSp) + call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS%set_visc_CSp) call disable_averaging(CS%diag) if (CS%debug) then diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 0711d2291d..53dddcf168 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -181,18 +181,17 @@ module MOM_CVMix_KPP !> Initialize the CVMix KPP module and set up diagnostics !! Returns True if KPP is to be used, False otherwise. -logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) +logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) ! Arguments type(param_file_type), intent(in) :: paramFile !< File parser type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(in) :: diag !< Diagnostics type(time_type), intent(in) :: Time !< Model time type(KPP_CS), pointer :: CS !< Control structure logical, optional, intent(out) :: passive !< Copy of %passiveMode - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! Local variables # include "version_variable.h" @@ -394,7 +393,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) call get_param(paramFile, mdl, "USE_KPP_LT_K", CS%LT_K_Enhancement, & 'Flag for Langmuir turbulence enhancement of turbulent'//& 'mixing coefficient.', units="", Default=.false.) - call get_param(paramFile, mdl, "STOKES_MIXING", CS%STOKES_MIXING, & + call get_param(paramFile, mdl, "STOKES_MIXING", CS%Stokes_Mixing, & 'Flag for Langmuir turbulence enhancement of turbulent'//& 'mixing coefficient.', units="", Default=.false.) if (CS%LT_K_Enhancement) then @@ -607,9 +606,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) end function KPP_init !> KPP vertical diffusivity/viscosity and non-local tracer transport -subroutine KPP_calculate(CS, G, GV, US, h, uStar, & - buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& - nonLocalTransScalar, waves, lamult) +subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & + nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -630,8 +628,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [m s-1] - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier + type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier ! Local variables integer :: i, j, k ! Loop indices @@ -650,6 +648,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & ! For Langmuir Calculations real :: LangEnhK ! Langmuir enhancement for mixing coefficient + if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & + "KPP_calculate: The Waves control structure must be associated if STOKES_MIXING is True.") if (CS%debug) then call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) @@ -671,7 +671,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !$OMP surfBuoyFlux, Kdiffusivity, Kviscosity, LangEnhK, sigma, & !$OMP sigmaRatio) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, Kt, & - !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, waves, lamult) + !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec @@ -920,7 +920,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl 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_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS + type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult!< Langmuir enhancement factor ! Local variables @@ -968,6 +968,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl integer :: B real :: WST + if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & + "KPP_compute_BLD: The Waves control structure must be associated if STOKES_MIXING is True.") if (CS%debug) then call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) @@ -1061,8 +1063,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH if (CS%Stokes_Mixing) then - surfHus = surfHus + 0.5*US%L_T_to_m_s*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH - surfHvs = surfHvs + 0.5*US%L_T_to_m_s*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH + surfHus = surfHus + 0.5*US%L_T_to_m_s*(Waves%US_x(i,j,ktmp)+Waves%US_x(i-1,j,ktmp)) * delH + surfHvs = surfHvs + 0.5*US%L_T_to_m_s*(Waves%US_y(i,j,ktmp)+Waves%US_y(i,j-1,ktmp)) * delH endif enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a546bcdec0..ff8c270a89 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -283,8 +283,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -473,7 +473,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1057,7 +1057,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1566,7 +1566,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & ea, & ! amount of fluid entrained from the layer above within diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 8557667c94..f7d3a361c6 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -235,8 +235,6 @@ module MOM_energetic_PBL real :: LAmod !< The modified Langmuir number by convection [nondim] real :: mstar !< The value of mstar used in ePBL [nondim] real :: mstar_LT !< The portion of mstar due to Langmuir turbulence [nondim] - real, allocatable, dimension(:) :: dT_expect !< Expected temperature changes [degC] - real, allocatable, dimension(:) :: dS_expect !< Expected salinity changes [ppt] end type ePBL_column_diags contains @@ -246,8 +244,7 @@ module MOM_energetic_PBL !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves ) + dSV_dT, dSV_dS, TKE_forced, buoy_flux, Waves ) 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 @@ -281,25 +278,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 s-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to mixedlayer_init. + !! call to energetic_PBL_init. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - logical, optional, intent(in) :: last_call !< If true, this is the last call to - !! mixedlayer in the current time step, so - !! diagnostics will be written. The default - !! is .true. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dT_expected !< The values of temperature change that - !! should be expected when the returned - !! diffusivities are applied [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dS_expected !< The values of salinity change that - !! should be expected when the returned - !! diffusivities are applied [ppt]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -357,12 +339,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: B_Flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]. -! The following are only used for diagnostics. - real :: dt__diag ! A copy of dt_diag (if present) or dt [T ~> s]. - logical :: write_diags ! If true, write out diagnostics with this step. - logical :: reset_diags ! If true, zero out the accumulated diagnostics. - - logical :: debug=.false. ! Change this hard-coded value for debugging. type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics. integer :: i, j, k, is, ie, js, je, nz @@ -376,39 +352,29 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS "energetic_PBL: Temperature, salinity and an equation of state "//& "must now be used.") if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, & - "energetic_PBL: No surface TKE fluxes (ustar) defined in mixedlayer!") - debug = .false. ; if (present(dT_expected) .or. present(dS_expected)) debug = .true. + "energetic_PBL: No surface TKE fluxes (ustar) defined in fluxes type!") + if (CS%use_LT .and. .not.associated(Waves)) call MOM_error(FATAL, & + "energetic_PBL: The Waves control structure must be associated if CS%use_LT "//& + "(i.e., USE_LA_LI2016 or EPBL_LT) is True.") - if (debug) allocate(eCD%dT_expect(nz), eCD%dS_expect(nz)) h_neglect = GV%H_subroundoff - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - write_diags = .true. ; if (present(last_call)) write_diags = last_call - - - ! Determine whether to zero out diagnostics before accumulation. - reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & - reset_diags = .false. ! This is the second call to mixedlayer. - - if (reset_diags) then - if (CS%TKE_diagnostics) then + ! Zero out diagnostics before accumulation. + if (CS%TKE_diagnostics) then !!OMP parallel do default(none) shared(is,ie,js,je,CS) - do j=js,je ; do i=is,ie - CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 - CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 - CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 - CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 - enddo ; enddo - endif + do j=js,je ; do i=is,ie + CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 + CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 + CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 + CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 + enddo ; enddo endif ! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0 ! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0 !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,debug, & -!!OMP TKE_forced,dSV_dT,dSV_dS,Kd_int) +!!OMP CS,G,GV,US,fluxes,TKE_forced,dSV_dT,dSV_dS,Kd_int) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie @@ -459,7 +425,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + US, CS, eCD, Waves, G, i, j) ! Copy the diffusivities to a 2-d array. @@ -468,13 +434,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo CS%ML_depth(i,j) = MLD_io - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = eCD%dT_expect(k) ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = eCD%dS_expect(k) ; enddo - endif - if (CS%TKE_diagnostics) then CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + eCD%dTKE_MKE CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + eCD%dTKE_conv @@ -500,40 +459,29 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! For masked points, Kd_int must still be set (to 0) because it has intent out. do K=1,nz+1 ; Kd_2d(i,K) = 0. ; enddo CS%ML_depth(i,j) = 0.0 - - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = 0.0 ; enddo - endif endif ; enddo ! Close of i-loop - Note unusual loop order! do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = Kd_2d(i,K) ; enddo ; enddo enddo ! j-loop - if (write_diags) then - if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) - endif - - if (debug) deallocate(eCD%dT_expect, eCD%dS_expect) + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) end subroutine energetic_PBL @@ -543,7 +491,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, i, j) + Waves, G, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -579,16 +527,12 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, dimension(SZK_(GV)+1), & intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to mixedlayer_init. + !! call to energetic_PBL_init. type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS for Langmuir turbulence - type(ocean_grid_type), & - optional, intent(inout) :: G !< The ocean's grid structure. - integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) - integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + integer, intent(in) :: i !< The i-index to work on (used for Waves) + integer, intent(in) :: j !< The i-index to work on (used for Waves) ! This subroutine determines the diffusivities in a single column from the integrated energetics ! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes @@ -746,8 +690,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! from the surface. ! The following are only used for diagnostics. - real :: dt__diag ! A copy of dt_diag (if present) or dt [T ~> s]. - real :: I_dtdiag ! = 1.0 / dt__diag [T-1 ~> s-1]. + real :: I_dtdiag ! = 1.0 / dt [T-1 ~> s-1]. !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth @@ -773,14 +716,15 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs integer :: OBL_it ! Iteration counter real :: Surface_Scale ! Surface decay scale for vstar - logical :: calc_dT_expect ! If true calculate the expected changes in temperature and salinity. - logical :: calc_Te ! If true calculate the expected final temperature and salinity values. - logical :: debug=.false. ! Change this hard-coded value for debugging. + logical :: calc_Te ! If true calculate the expected final temperature and salinity values. + logical :: debug ! This is used as a hard-coded value for debugging. ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k + real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [degC] + real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [ppt] integer, dimension(SZK_(GV)) :: num_itts integer :: k, nz, itt, max_itt @@ -790,14 +734,13 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& "Module must be initialized before it is used.") - calc_dT_expect = debug ; if (allocated(eCD%dT_expect) .or. allocated(eCD%dS_expect)) calc_dT_expect = .true. - calc_Te = (calc_dT_expect .or. (.not.CS%orig_PE_calc)) + debug = .false. ! Change this hard-coded value for debugging. + calc_Te = (debug .or. (.not.CS%orig_PE_calc)) h_neglect = GV%H_subroundoff C1_3 = 1.0 / 3.0 - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - I_dtdiag = 1.0 / dt__diag + I_dtdiag = 1.0 / dt max_itt = 20 h_tt_min = 0.0 @@ -866,8 +809,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 if (CS%Use_LT) then - call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=h, U_H=u, V_H=v, Waves=Waves) + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, h, Waves, & + U_H=u, V_H=v) call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_Guess, absf, & MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& mstar_LT=mstar_LT) @@ -1396,16 +1339,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs enddo Kd(nz+1) = 0.0 - if (calc_dT_expect) then + if (debug) then ! Complete the tridiagonal solve for Te. b1 = 1.0 / hp_a Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) - eCD%dT_expect(nz) = Te(nz) - T0(nz) ; eCD%dS_expect(nz) = Se(nz) - S0(nz) + dT_expect(nz) = Te(nz) - T0(nz) ; dS_expect(nz) = Se(nz) - S0(nz) do k=nz-1,1,-1 Te(k) = Te(k) + c1(K+1)*Te(k+1) Se(k) = Se(k) + c1(K+1)*Se(k+1) - eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) + dT_expect(k) = Te(k) - T0(k) ; dS_expect(k) = Se(k) - S0(k) enddo endif @@ -1538,8 +1481,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! height, including all implicit diffusive changes !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. - real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. + real, intent(out) :: PE_chg !< The change in column potential energy from applying + !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h !! [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could @@ -1550,6 +1493,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: PE_ColHt_cor !< The correction to PE_chg that is made due to a net !! change in the column height [R Z3 T-2 ~> J m-2]. + ! Local variables real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. @@ -1579,18 +1523,14 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & ColHt_core = hp_b * (dT_to_dColHt_a * dT_c + dS_to_dColHt_a * dS_c) - & hp_a * (dT_to_dColHt_b * dT_c + dS_to_dColHt_b * dS_c) - if (present(PE_chg)) then - ! Find the change in column potential energy due to the change in the - ! diffusivity at this interface by dKddt_h. - y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - PE_chg = PEc_core * y1_3 - ColHt_chg = ColHt_core * y1_3 - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg - if (present(PE_ColHt_cor)) PE_ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) - elseif (present(PE_ColHt_cor)) then - y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - PE_ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) - endif + ! Find the change in column potential energy due to the change in the + ! diffusivity at this interface by dKddt_h. + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + PE_chg = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg + + if (present(PE_ColHt_cor)) PE_ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) if (present(dPEc_dKd)) then ! Find the derivative of the potential energy change with dKddt_h. @@ -1624,8 +1564,8 @@ end subroutine find_PE_chg subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dT_km1_t2, dS_km1_t2, dT_to_dPE_k, dS_to_dPE_k, & dT_to_dPEa, dS_to_dPEa, pres_Z, dT_to_dColHt_k, & - dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, & - PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) + dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, PE_chg, & + dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and !! divided by the average of the thicknesses around the !! interface [H ~> m or kg m-2]. @@ -1678,8 +1618,8 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! height, including all implicit diffusive changes !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. - real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. + real, intent(out) :: PE_chg !< The change in column potential energy from applying + !! Kddt_h at the present interface [R Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h !! [R Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could @@ -1697,6 +1637,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! this routine can also be used for an upward pass with the sense of direction ! reversed. + ! Local variables real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: b1Kd ! Temporary array [nondim] real :: ColHt_chg ! The change in column thickness [Z ~> m]. @@ -1722,17 +1663,15 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dT_k = (Kddt_h*I_Kr_denom) * dTe_term dS_k = (Kddt_h*I_Kr_denom) * dSe_term - if (present(PE_chg)) then - ! Find the change in energy due to diffusion with strength Kddt_h at this interface. - ! Increment the temperature changes in layer k-1 due the changes in layer k. - dT_km1 = b1Kd * ( dT_k + dT_km1_t2 ) - dS_km1 = b1Kd * ( dS_k + dS_km1_t2 ) - PE_chg = (dT_to_dPE_k * dT_k + dT_to_dPEa * dT_km1) + & - (dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1) - ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + & - (dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1) - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg - endif + ! Find the change in energy due to diffusion with strength Kddt_h at this interface. + ! Increment the temperature changes in layer k-1 due the changes in layer k. + dT_km1 = b1Kd * ( dT_k + dT_km1_t2 ) + dS_km1 = b1Kd * ( dS_k + dS_km1_t2 ) + PE_chg = (dT_to_dPE_k * dT_k + dT_to_dPEa * dT_km1) + & + (dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1) + ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + & + (dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1) + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg if (present(dPEc_dKd)) then ! Find the derivatives of the temperature and salinity changes with Kddt_h. @@ -1992,7 +1931,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"//& + call MOM_error(WARNING, "energetic_PBL_init called with an associated"//& "associated control structure.") return else ; allocate(CS) ; endif @@ -2255,13 +2194,13 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "determine the Langmuir number.", units="nondim", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. if (use_LA_windsea) then - CS%USE_LT = .true. + CS%use_LT = .true. else - call get_param(param_file, mdl, "EPBL_LT", CS%USE_LT, & + call get_param(param_file, mdl, "EPBL_LT", CS%use_LT, & "A logical to use a LT parameterization.", & units="nondim", default=.false.) endif - if (CS%USE_LT) then + if (CS%use_LT) then call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& "Valid values are: \n"//& diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 51c67504d4..507960cf1f 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -1116,20 +1116,20 @@ end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS), pointer :: CS !< An opacity control structure that should be deallocated. - type(optics_type), optional, pointer :: optics !< An optics type structure that should be deallocated. + type(opacity_CS), pointer :: CS !< An opacity control structure that should be deallocated. + type(optics_type), pointer :: optics !< An optics type structure that should be deallocated. if (associated(CS%id_opacity)) deallocate(CS%id_opacity) if (associated(CS)) deallocate(CS) - if (present(optics)) then ; if (associated(optics)) then + if (associated(optics)) then if (associated(optics%sw_pen_band)) deallocate(optics%sw_pen_band) if (associated(optics%opacity_band)) deallocate(optics%opacity_band) if (associated(optics%max_wavelength_band)) & deallocate(optics%max_wavelength_band) if (associated(optics%min_wavelength_band)) & deallocate(optics%min_wavelength_band) - endif ; endif + endif end subroutine opacity_end diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c6892249f0..c5f813912d 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1705,7 +1705,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! This subroutine calculates several properties related to bottom ! boundary layer turbulence. @@ -1736,10 +1736,10 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) local_open_u_BC = .false. local_open_v_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_u_BC = OBC%open_u_BCs_exist_globally local_open_v_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index e72575b86a..1cf3b5ddc9 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -115,7 +115,7 @@ module MOM_set_visc contains !> Calculates the thickness of the bottom boundary layer and the viscosity within that layer. -subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) +subroutine set_viscous_BBL(u, v, h, tv, visc, 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 @@ -132,9 +132,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !! related fields. type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to set_visc_init. - logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations - !! of those values in visc that would be - !! calculated with symmetric memory. ! Local variables real, dimension(SZIB_(G)) :: & @@ -280,7 +277,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(ocean_OBC_type), pointer :: OBC => NULL() 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 + Isq = G%isc-1 ; Ieq = G%IecB ; Jsq = G%jsc-1 ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H @@ -291,10 +288,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) "Module must be initialized before it is used.") if (.not.CS%bottomdraglaw) return - if (present(symmetrize)) then ; if (symmetrize) then - Jsq = js-1 ; Isq = is-1 - endif ; endif - if (CS%debug) then call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) call hchksum(h,"Start set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m) @@ -1134,7 +1127,7 @@ end function set_u_at_v !! A bulk Richardson criterion or the thickness of the topmost NKML layers (with a bulk mixed layer) !! are currently used. The thicknesses are given in terms of fractional layers, so that this !! thickness will move as the thickness of the topmost layers change. -subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetrize) +subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1153,9 +1146,6 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real, intent(in) :: dt !< Time increment [T ~> s]. type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to set_visc_init. - logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations - !! of those values in visc that would be - !! calculated with symmetric memory. ! Local variables real, dimension(SZIB_(G)) :: & @@ -1254,7 +1244,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(ocean_OBC_type), pointer :: OBC => NULL() 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 + Isq = G%isc-1 ; Ieq = G%IecB ; Jsq = G%jsc-1 ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(visc_ML): "//& @@ -1262,10 +1252,6 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (.not.(CS%dynamic_viscous_ML .or. associated(forces%frac_shelf_u) .or. & associated(forces%frac_shelf_v)) ) return - if (present(symmetrize)) then ; if (symmetrize) then - Jsq = js-1 ; Isq = is-1 - endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 10c3af7385..0085e67212 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -780,7 +780,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isc,G%iec Top = h(ii,jj,1)*GV%H_to_Z call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, & - H(ii,jj,:),Override_MA=.false.,WAVES=CS) + h(ii,jj,:), CS, Override_MA=.false.) CS%La_turb(ii,jj) = La enddo enddo @@ -931,29 +931,27 @@ end subroutine Surface_Bands_by_data_override !! Note this can be called with an unallocated Waves pointer, which is okay if we !! want the wind-speed only dependent Langmuir number. Therefore, we need to be !! careful about what we try to access here. -subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & - H, U_H, V_H, Override_MA, Waves ) - 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 - integer, intent(in) :: i !< Meridional index of h-point - integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1]. - real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m]. - logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA - !! calculation. This can be used if diagnostic - !! LA outputs are desired that are different than - !! those used by the dynamical model. - real, dimension(SZK_(GV)), optional, & - intent(in) :: H !< Grid layer thickness [H ~> m or kg m-2] - real, dimension(SZK_(GV)), optional, & - intent(in) :: U_H !< Zonal velocity at H point [L T-1 ~> m s-1] or [m s-1] - real, dimension(SZK_(GV)), optional, & - intent(in) :: V_H !< Meridional velocity at H point [L T-1 ~> m s-1] or [m s-1] - type(Wave_parameters_CS), & - pointer :: Waves !< Surface wave control structure. +subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & + U_H, V_H, Override_MA ) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, intent(out) :: LA !< Langmuir number [nondim] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m] + real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1] + integer, intent(in) :: i !< Meridional index of h-point + integer, intent(in) :: j !< Zonal index of h-point + real, dimension(SZK_(GV)), intent(in) :: h !< Grid layer thickness [H ~> m or kg m-2] + type(Wave_parameters_CS), pointer :: Waves !< Surface wave control structure. + real, dimension(SZK_(GV)), & + optional, intent(in) :: U_H !< Zonal velocity at H point [L T-1 ~> m s-1] or [m s-1] + real, dimension(SZK_(GV)), & + optional, intent(in) :: V_H !< Meridional velocity at H point [L T-1 ~> m s-1] or [m s-1] + logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA + !! calculation. This can be used if diagnostic + !! LA outputs are desired that are different than + !! those used by the dynamical model. - real, intent(out) :: LA !< Langmuir number [nondim] !Local Variables real :: Top, bottom, midpoint ! Positions within each layer [Z ~> m] @@ -975,9 +973,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! If requesting to use misalignment in the Langmuir number compute the Shear Direction if (USE_MA) then - if (.not.(present(H).and.present(U_H).and.present(V_H))) then - call MOM_error(Fatal,'Get_LA_waves requested to consider misalignment.') - endif + if (.not.(present(U_H).and.present(V_H))) call MOM_error(FATAL, & + "Get_LA_waves requested to consider misalignment, but velocities were not provided.") ContinueLoop = .true. bottom = 0.0 do kk = 1,GV%ke @@ -993,30 +990,30 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & if (Waves%WaveMethod==TESTPROF) then 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)) + 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 - call Get_SL_Average_Prof( GV, Dpt_LASL, H, US_H, LA_STKx) - call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY) elseif (Waves%WaveMethod==SURFBANDS) then - allocate(StkBand_X(WAVES%NumBands), StkBand_Y(WAVES%NumBands)) - do bb = 1,WAVES%NumBands - StkBand_X(bb) = 0.5*(WAVES%STKx0(I,j,bb)+WAVES%STKx0(I-1,j,bb)) - StkBand_Y(bb) = 0.5*(WAVES%STKy0(i,J,bb)+WAVES%STKy0(i,J-1,bb)) + allocate(StkBand_X(Waves%NumBands), StkBand_Y(Waves%NumBands)) + do bb = 1,Waves%NumBands + StkBand_X(bb) = 0.5*(Waves%STKx0(I,j,bb)+Waves%STKx0(I-1,j,bb)) + StkBand_Y(bb) = 0.5*(Waves%STKy0(i,J,bb)+Waves%STKy0(i,J-1,bb)) enddo - call Get_SL_Average_Band(GV, Dpt_LASL, WAVES%NumBands, WAVES%WaveNum_Cen, StkBand_X, LA_STKx ) - call Get_SL_Average_Band(GV, Dpt_LASL, WAVES%NumBands, WAVES%WaveNum_Cen, StkBand_Y, LA_STKy ) + call Get_SL_Average_Band(GV, Dpt_LASL, Waves%NumBands, Waves%WaveNum_Cen, StkBand_X, LA_STKx ) + call Get_SL_Average_Band(GV, Dpt_LASL, Waves%NumBands, Waves%WaveNum_Cen, StkBand_Y, LA_STKy ) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) deallocate(StkBand_X, StkBand_Y) elseif (Waves%WaveMethod==DHH85) then ! Temporarily integrating profile rather than spectrum for simplicity 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)) + 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 - call Get_SL_Average_Prof( GV, Dpt_LASL, H, US_H, LA_STKx) - call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx) + call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (Waves%WaveMethod==LF17) then call get_StokesSL_LiFoxKemper(ustar, hbl*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA) @@ -1034,7 +1031,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! to prevent large enhancements in unconstrained parts of ! the curve fit parameterizations. ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. - LA = max(WAVES%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + 1.e-10*US%m_s_to_L_T))) + LA = max(Waves%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + 1.e-10*US%m_s_to_L_T))) endif if (Use_MA) then @@ -1421,7 +1418,7 @@ end subroutine StokesMixing !! CHECK THAT RIGHT TIMESTEP IS PASSED IF YOU USE THIS** !! !! Not accessed in the standard code. -subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) +subroutine CoriolisStokes(G, GV, dt, h, u, v, Waves) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1435,16 +1432,16 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) intent(inout) :: v !< Velocity j-component [L T-1 ~> m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local variables real :: DVel ! A rescaled velocity change [L T-2 ~> m s-2] - integer :: i,j,k + integer :: i, j, k 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) + & - 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) + DVel = 0.25*(Waves%us_y(i,j+1,k)+Waves%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & + 0.25*(Waves%us_y(i,j,k)+Waves%us_y(i-1,j,k))*G%CoriolisBu(i,j) u(I,j,k) = u(I,j,k) + DVEL*dt enddo enddo @@ -1453,8 +1450,8 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, WAVES, US) 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) + & - 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) + DVel = 0.25*(Waves%us_x(i+1,j,k)+Waves%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & + 0.25*(Waves%us_x(i,j,k)+Waves%us_x(i,j-1,k))*G%CoriolisBu(i,j) v(i,J,k) = v(i,j,k) - DVEL*dt enddo enddo From 6ff0caec66ecd3817a8cded0b82a53f165584942 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 22 Oct 2021 14:58:18 -0400 Subject: [PATCH 016/138] Use FMS2 `file_exists`, remove domain args This patch uses the FMS2 `file_exists` function when using the FMS2 infra. Previously, the FMS1 version of this function was being used. This patch also removes the `mpp_domain` and `no_domain` arguments from the direct `file_exist` calls, which were not used by any known MOM6 configurations. (Nor would we expect them to be, since explicit references to FMS should not exist outside of the infra layer.) Since FMS2 does not use these arguments, their removal also creates a more meaningful interface between the two frameworks. Motivation: An issue with the FMS1 `file_exists` under the FMS2 infra was discovered in the UFS model on Hera. It was only reproducible in submitted jobs, and not for interactive jobs, and only with the GCC 9.2 compiler. (Other GCC versions were not tested.) One potential explanation is that it is related to the `save` attribute of the domain pointer, `d_ptr`. In the case above, `d_ptr` pointed to the MOM input domain for the failed cases. For the other working cases, `d_ptr` pointed to a `NULL()` value and behavior was normal. It is possible that `d_ptr` is inconsisently updated when FMS1 and FMS2 IO operations are used together, which should probably be considered undefined behavior. --- config_src/infra/FMS1/MOM_io_infra.F90 | 11 ++++------- config_src/infra/FMS2/MOM_io_infra.F90 | 12 +++++------- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index 1501f3171b..f956f9fa51 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -137,15 +137,12 @@ logical function MOM_file_exists(filename, MOM_Domain) end function MOM_file_exists !> Returns true if the named file or its domain-decomposed variant exists. -logical function FMS_file_exists(filename, domain, no_domain) +logical function FMS_file_exists(filename) character(len=*), intent(in) :: filename !< The name of the file being inquired about - type(domain2d), optional, intent(in) :: domain !< The mpp domain2d that describes the decomposition - logical, optional, intent(in) :: no_domain !< This file does not use domain decomposition -! This function uses the fms_io function file_exist to determine whether -! a named file (or its decomposed variant) exists. - - FMS_file_exists = file_exist(filename, domain, no_domain) + ! This function uses the fms_io function file_exist to determine whether + ! a named file (or its decomposed variant) exists. + FMS_file_exists = file_exist(filename) end function FMS_file_exists !> indicates whether an I/O handle is attached to an open file diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 0b8c19d836..62a43ab99b 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -17,6 +17,7 @@ module MOM_io_infra use fms2_io_mod, only : get_variable_dimension_names, is_dimension_registered, get_dimension_size use fms2_io_mod, only : is_dimension_unlimited, register_axis, unlimited use fms2_io_mod, only : get_global_io_domain_indices +use fms_io_utils_mod, only : fms2_file_exist => file_exists use fms_mod, only : write_version_number, open_namelist_file, check_nml_error use fms_io_mod, only : file_exist, field_exist, field_size, read_data @@ -170,15 +171,12 @@ logical function MOM_file_exists(filename, MOM_Domain) end function MOM_file_exists !> Returns true if the named file or its domain-decomposed variant exists. -logical function FMS_file_exists(filename, domain, no_domain) +logical function FMS_file_exists(filename) character(len=*), intent(in) :: filename !< The name of the file being inquired about - type(domain2d), optional, intent(in) :: domain !< The mpp domain2d that describes the decomposition - logical, optional, intent(in) :: no_domain !< This file does not use domain decomposition -! This function uses the fms_io function file_exist to determine whether -! a named file (or its decomposed variant) exists. - - FMS_file_exists = file_exist(filename, domain, no_domain) + ! This function uses the fms_io function file_exist to determine whether + ! a named file (or its decomposed variant) exists. + FMS_file_exists = fms2_file_exist(filename) end function FMS_file_exists !> indicates whether an I/O handle is attached to an open file From ee3b92f571f575244757b59e4f77c7a3554fa449 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Mon, 11 Oct 2021 16:57:44 -0400 Subject: [PATCH 017/138] fix low mode in tidal_mixing --- .../lateral/MOM_internal_tides.F90 | 8 ++++---- .../vertical/MOM_set_diffusivity.F90 | 4 ++-- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 13 ++++++------- 3 files changed, 12 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 54370611ad..860b5233c9 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1451,9 +1451,9 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected ! and will eventually propagate out of cell. (This code only reflects if En > 0.) call reflect(Fdt_m, Nangle, CS, G, LB) - call teleport(Fdt_m, Nangle, CS, G, LB) + !call teleport(Fdt_m, Nangle, CS, G, LB) call reflect(Fdt_p, Nangle, CS, G, LB) - call teleport(Fdt_p, Nangle, CS, G, LB) + !call teleport(Fdt_p, Nangle, CS, G, LB) ! Update reflected energy [R Z3 T-2 ~> J m-2] do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh @@ -1533,9 +1533,9 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected ! and will eventually propagate out of cell. (This code only reflects if En > 0.) call reflect(Fdt_m, Nangle, CS, G, LB) - call teleport(Fdt_m, Nangle, CS, G, LB) + !call teleport(Fdt_m, Nangle, CS, G, LB) call reflect(Fdt_p, Nangle, CS, G, LB) - call teleport(Fdt_p, Nangle, CS, G, LB) + !call teleport(Fdt_p, Nangle, CS, G, LB) ! Update reflected energy [R Z3 T-2 ~> J m-2] do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c5f813912d..c8737653bc 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2058,8 +2058,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "forms of the same expressions.", default=default_2018_answers) ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. - CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, diag, & - CS%tidal_mixing_CSp) + CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, & + CS%int_tide_CSp, diag, CS%tidal_mixing_CSp) call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 3b26d60451..760e9ee8ec 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -12,6 +12,7 @@ module MOM_tidal_mixing use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, MOM_read_data, field_size +use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h use MOM_string_functions, only : uppercase, lowercase use MOM_unit_scaling, only : unit_scale_type @@ -155,6 +156,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [Z2 ~> m2]. real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [Z T-1 ~> m s-1] + type(int_tide_CS), pointer :: int_tide_CSp=> NULL() !< Control structure for a child module real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] real, allocatable, dimension(:,:) :: tidal_qe_2d !< Tidal energy input times the local dissipation !! fraction, q*E(x,y), with the CVMix implementation @@ -209,12 +211,13 @@ module MOM_tidal_mixing contains !> Initializes internal tidal dissipation scheme for diapycnal mixing -logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) +logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, diag, CS) type(time_type), intent(in) :: Time !< The current time. 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 type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(int_tide_CS),target, intent(in) :: int_tide_CSp !< A pointer to the internal tides control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(tidal_mixing_cs), pointer :: CS !< This module's control structure. @@ -272,6 +275,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%dd) CS%debug = CS%debug.and.is_root_pe() CS%diag => diag + CS%int_tide_CSp => int_tide_CSp CS%use_CVmix_tidal = use_CVmix_tidal CS%int_tide_dissipation = int_tide_dissipation @@ -1215,12 +1219,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_bot(i) = 0.0 if (CS%Lowmode_itidal_dissipation) then ! get loss rate due to wave drag on low modes (already multiplied by q) - - ! TODO: uncomment the following call and fix it - !call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot) - write (mesg,*) "========", __FILE__, __LINE__ - call MOM_error(FATAL,trim(mesg)//": this block not supported yet. (aa)") - + call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot) TKE_lowmode_bot(i) = CS%Mu_itides * I_rho0 * TKE_lowmode_tot endif ! Vertical energy flux at bottom From 7e8d6e2f4ac3c78d536b1c7362bae4fa293db4ce Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 19 Oct 2021 09:06:56 -0400 Subject: [PATCH 018/138] +Eliminate unused arguments in diagnostics code Eliminated the unused optional OBC argument to write_energy() and several unused optional arguments to wave_speed() and wave_speeds() that are set instead via arguments to wave_speed_init() that store these values in a wave_speed_CS type. Also made the optional row_scale argument to tridiag_det() and the tracer_CSp argument to write_energy() that were always present in calls into mandatory arguments. All answers are bitwise identical, and solutions do not change. --- src/diagnostics/MOM_sum_output.F90 | 95 ++++++++++-------------------- src/diagnostics/MOM_wave_speed.F90 | 30 ++-------- 2 files changed, 37 insertions(+), 88 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index d190cee7a3..5f144af4d5 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -18,8 +18,6 @@ module MOM_sum_output use MOM_io, only : axis_info, set_axis_info, delete_axis_info, get_filename_appendix use MOM_io, only : attribute_info, set_attribute_info, delete_attribute_info use MOM_io, only : APPEND_FILE, SINGLE_FILE, WRITEONLY_FILE -use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type -use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_time_manager, only : time_type, get_time, get_date, set_time, operator(>) use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(/=), operator(<=), operator(>=), operator(<) @@ -297,7 +295,7 @@ end subroutine MOM_sum_output_end !> This subroutine calculates and writes the total model energy, the energy and !! mass of each layer, and other globally integrated physical quantities. -subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_forcing) +subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forcing) 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 @@ -314,11 +312,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ !! current execution. type(Sum_output_CS), pointer :: CS !< The control structure returned by a !! previous call to MOM_sum_output_init. - type(tracer_flow_control_CS), & - optional, pointer :: tracer_CSp !< tracer control structure. - type(ocean_OBC_type), & - optional, pointer :: OBC !< Open boundaries control structure. + type(tracer_flow_control_CS), pointer :: tracer_CSp !< Control structure with the tree of + !! all registered tracer packages type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step + ! Local variables 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]. @@ -409,17 +406,22 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ character(len=32) :: mesg_intro, time_units, day_str, n_str, date_str logical :: date_stamped type(time_type) :: dt_force ! A time_type version of the forcing timestep. - real :: Tr_stocks(MAX_FIELDS_) - real :: Tr_min(MAX_FIELDS_), Tr_max(MAX_FIELDS_) - real :: Tr_min_x(MAX_FIELDS_), Tr_min_y(MAX_FIELDS_), Tr_min_z(MAX_FIELDS_) - real :: Tr_max_x(MAX_FIELDS_), Tr_max_y(MAX_FIELDS_), Tr_max_z(MAX_FIELDS_) - logical :: Tr_minmax_got(MAX_FIELDS_) = .false. + real :: Tr_stocks(MAX_FIELDS_) ! The total amounts of each of the registered tracers + real :: Tr_min(MAX_FIELDS_) ! The global minimum unmasked value of the tracers + real :: Tr_max(MAX_FIELDS_) ! The global maximum unmasked value of the tracers + real :: Tr_min_x(MAX_FIELDS_) ! The x-positions of the global tracer minima + real :: Tr_min_y(MAX_FIELDS_) ! The y-positions of the global tracer minima + real :: Tr_min_z(MAX_FIELDS_) ! The z-positions of the global tracer minima + real :: Tr_max_x(MAX_FIELDS_) ! The x-positions of the global tracer maxima + real :: Tr_max_y(MAX_FIELDS_) ! The y-positions of the global tracer maxima + real :: Tr_max_z(MAX_FIELDS_) ! The z-positions of the global tracer maxima + logical :: Tr_minmax_avail(MAX_FIELDS_) ! A flag indicating whether the global minimum and + ! maximum information are available for each of the tracers character(len=40), dimension(MAX_FIELDS_) :: & - Tr_names, Tr_units - integer :: nTr_stocks + Tr_names, & ! The short names for each of the tracers + Tr_units ! The units for each of the tracers + integer :: nTr_stocks ! The total number of tracers in all registered tracer packages integer :: iyear, imonth, iday, ihour, iminute, isecond, itick ! For call to get_date() - logical :: local_open_BC - type(OBC_segment_type), pointer :: segment => NULL() ! A description for output of each of the fields. type(vardesc) :: vars(NUM_FIELDS+MAX_FIELDS_) @@ -479,16 +481,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ vars(17) = var_desc("Heat_anom","Joules","Anomalous Total Heat Change",'1','1') endif - local_open_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then - 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 = 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) - HL2_to_kg = GV%H_to_kg_m2*US%L_to_m**2 if (.not.associated(CS)) call MOM_error(FATAL, & @@ -504,34 +500,6 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ tmp1(i,j,k) = h(i,j,k) * (HL2_to_kg*areaTm(i,j)) enddo ; enddo ; enddo - ! This block avoids using the points beyond an open boundary condition - ! in the accumulation of mass, but perhaps it would be unnecessary if there - ! were a more judicious use of masks in the loops 4 or 7 lines above. - if (local_open_BC) then - do ns=1, OBC%number_of_segments - segment => OBC%segment(ns) - if (.not. segment%on_pe .or. segment%specified) cycle - I=segment%HI%IsdB ; J=segment%HI%JsdB - if (segment%direction == OBC_DIRECTION_E) then - do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed - tmp1(i+1,j,k) = 0.0 - enddo ; enddo - elseif (segment%direction == OBC_DIRECTION_W) then - do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed - tmp1(i,j,k) = 0.0 - enddo ; enddo - elseif (segment%direction == OBC_DIRECTION_N) then - do k=1,nz ; do i=segment%HI%isd,segment%HI%ied - tmp1(i,j+1,k) = 0.0 - enddo ; enddo - elseif (segment%direction == OBC_DIRECTION_S) then - do k=1,nz ; do i=segment%HI%isd,segment%HI%ied - tmp1(i,j,k) = 0.0 - enddo ; enddo - endif - enddo - endif - mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP) do k=1,nz ; vol_lay(k) = (US%m_to_L**2*GV%H_to_Z/GV%H_to_kg_m2)*mass_lay(k) ; enddo else @@ -558,19 +526,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif ! Boussinesq nTr_stocks = 0 - if (present(tracer_CSp)) then - call call_tracer_stocks(h, Tr_stocks, G, GV, tracer_CSp, stock_names=Tr_names, & - stock_units=Tr_units, num_stocks=nTr_stocks,& - got_min_max=Tr_minmax_got, global_min=Tr_min, global_max=Tr_max, & - xgmin=Tr_min_x, ygmin=Tr_min_y, zgmin=Tr_min_z,& - xgmax=Tr_max_x, ygmax=Tr_max_y, zgmax=Tr_max_z) - if (nTr_stocks > 0) then - do m=1,nTr_stocks - vars(num_nc_fields+m) = var_desc(Tr_names(m), units=Tr_units(m), & - longname=Tr_names(m), hor_grid='1', z_grid='1') - enddo - num_nc_fields = num_nc_fields + nTr_stocks - endif + Tr_minmax_avail(:) = .false. + call call_tracer_stocks(h, Tr_stocks, G, GV, tracer_CSp, stock_names=Tr_names, & + stock_units=Tr_units, num_stocks=nTr_stocks,& + got_min_max=Tr_minmax_avail, global_min=Tr_min, global_max=Tr_max, & + xgmin=Tr_min_x, ygmin=Tr_min_y, zgmin=Tr_min_z,& + xgmax=Tr_max_x, ygmax=Tr_max_y, zgmax=Tr_max_z) + if (nTr_stocks > 0) then + do m=1,nTr_stocks + vars(num_nc_fields+m) = var_desc(Tr_names(m), units=Tr_units(m), & + longname=Tr_names(m), hor_grid='1', z_grid='1') + enddo + num_nc_fields = num_nc_fields + nTr_stocks endif if (CS%previous_calls == 0) then @@ -884,7 +851,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ write(stdout,'(" Total ",a,": ",ES24.16,X,a)') & trim(Tr_names(m)), Tr_stocks(m), trim(Tr_units(m)) - if (Tr_minmax_got(m)) then + if (Tr_minmax_avail(m)) then write(stdout,'(64X,"Global Min:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & Tr_min(m),Tr_min_x(m),Tr_min_y(m),Tr_min_z(m) write(stdout,'(64X,"Global Max:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 6a4d9660d7..a468f36658 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -55,7 +55,7 @@ module MOM_wave_speed !> Calculates the wave speed of the first baroclinic mode. subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_N2_column_fraction, & - mono_N2_depth, modal_structure, better_speed_est, min_speed, wave_speed_tol) + mono_N2_depth, modal_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 @@ -76,12 +76,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !! modal structure [Z ~> m]. 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. - real, optional, intent(in) :: min_speed !< If present, set a floor in the first mode speed - !! below which 0 is returned [L T-1 ~> m s-1]. - real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the - !! wave speeds [nondim] ! Local variables real, dimension(SZK_(GV)+1) :: & @@ -181,10 +175,10 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) use_EOS = associated(tv%eqn_of_state) - better_est = CS%better_cg1_est ; if (present(better_speed_est)) better_est = better_speed_est + better_est = CS%better_cg1_est if (better_est) then - tol_solve = CS%wave_speed_tol ; if (present(wave_speed_tol)) tol_solve = wave_speed_tol + tol_solve = CS%wave_speed_tol tol_Hfrac = 0.1*tol_solve ; tol_merge = tol_solve / real(nz) else tol_solve = 0.001 ; tol_Hfrac = 0.0001 ; tol_merge = 0.001 @@ -197,7 +191,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ ! worst possible oceanic case of g'H < 0.5*10m/s2*1e4m = 5.e4 m2/s2 < 1024**2*c2_scale, suggesting ! that c2_scale can safely be set to 1/(16*1024**2), which would decrease the stable floor on ! min_speed to ~6.9e-8 m/s for 90 layers or 2.33e-7 m/s for 1000 layers. - cg1_min2 = CS%min_speed2 ; if (present(min_speed)) cg1_min2 = min_speed**2 + cg1_min2 = CS%min_speed2 rescale = 1024.0**4 ; I_rescale = 1.0/rescale c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. @@ -638,8 +632,7 @@ subroutine tdma6(n, a, c, lam, y) end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. -subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_speed_est, & - min_speed, wave_speed_tol) +subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -650,12 +643,6 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee type(wave_speed_CS), optional, pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. - 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. - real, optional, intent(in) :: min_speed !< If present, set a floor in the first mode speed - !! below which 0 is returned [L T-1 ~> m s-1]. - real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the - !! wave speeds [nondim] ! Local variables real, dimension(SZK_(GV)+1) :: & @@ -757,16 +744,13 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos, better_spee c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. better_est = .false. ; if (present(CS)) better_est = CS%better_cg1_est - if (present(better_speed_est)) better_est = better_speed_est if (better_est) then tol_solve = 0.001 ; if (present(CS)) tol_solve = CS%wave_speed_tol - if (present(wave_speed_tol)) tol_solve = wave_speed_tol tol_Hfrac = 0.1*tol_solve ; tol_merge = tol_solve / real(nz) else tol_solve = 0.001 ; tol_Hfrac = 0.0001 ; tol_merge = 0.001 endif cg1_min2 = 0.0 ; if (present(CS)) cg1_min2 = CS%min_speed2 - if (present(min_speed)) cg1_min2 = min_speed**2 ! Zero out all wave speeds. Values over land or for columns that are too weakly stratified ! are not changed from this zero value. @@ -1151,18 +1135,16 @@ subroutine tridiag_det(a, c, ks, ke, lam, det, ddet, row_scale) real, intent(in) :: lam !< Value subtracted from b real, intent(out):: det !< Determinant real, intent(out):: ddet !< Derivative of determinant with lam - real, optional, intent(in) :: row_scale !< A scaling factor of the rows of the + real, intent(in) :: row_scale !< A scaling factor of the rows of the !! matrix to limit the growth of the determinant ! Local variables real :: detKm1, detKm2 ! Cumulative value of the determinant for the previous two layers. real :: ddetKm1, ddetKm2 ! Derivative of the cumulative determinant with lam for the previous two layers. real, parameter :: rescale = 1024.0**4 ! max value of determinant allowed before rescaling - real :: rscl ! A rescaling factor that is applied succesively to each row. real :: I_rescale ! inverse of rescale integer :: k ! row (layer interface) index I_rescale = 1.0 / rescale - rscl = 1.0 ; if (present(row_scale)) rscl = row_scale detKm1 = 1.0 ; ddetKm1 = 0.0 det = (a(ks)+c(ks)) - lam ; ddet = -1.0 From a2aaad6df3bacf81ab4cfc0530cd99b26396aa28 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 13 Oct 2021 16:13:07 -0400 Subject: [PATCH 019/138] Always create single-threaded files in 1 PE runs Modified create_file to always specify that the threading will be for a single PE to do the writing to a single file if there is only a single ocean PE, to avoid some incorrect behavior inside of the FMS IO modules. This can fix restart problems in some single-processor cases with an inconsistent setting of the optional threading argument, but in all cases that ran correctly before, all answers are bitwise identical. --- src/framework/MOM_io.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 00eeb4cf89..563f9f9f8a 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -6,7 +6,7 @@ module MOM_io use MOM_array_transform, only : allocate_rotated_array, rotate_array use MOM_array_transform, only : rotate_array_pair, rotate_vector use MOM_domains, only : MOM_domain_type, domain1D, broadcast, get_domain_components -use MOM_domains, only : rescale_comp_data, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : rescale_comp_data, num_PEs, AGRID, BGRID_NE, CGRID_NE use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_ensemble_manager, only : get_ensemble_id use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING, is_root_PE @@ -236,6 +236,8 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim IsgB = dG%IsgB ; IegB = dG%IegB ; JsgB = dG%JsgB ; JegB = dG%JegB endif + if (domain_set .and. (num_PEs() == 1)) thread = SINGLE_FILE + one_file = .true. if (domain_set) one_file = (thread == SINGLE_FILE) From 6dd1d14b3cc0cf5e8abd39f61e781e54c3e39e22 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 20 Oct 2021 10:26:42 -0400 Subject: [PATCH 020/138] +Optional arg cleanup in horizontal param code Cleaned up 13 falsely optional or unused arguments in the horizontal parameterization code, and related changes. This includes: - Made the previously optional OBC pointer arguments that were always being used in calls to 3 routines in MOM_lateral_mixing_coeffs.F90 into mandatory arguments. Because these are pointers, the deciding factor of whether to use them is really whether they are associated. - Made an internal optional argument that was always being used mandatory in 2 routines in MOM_internal_tides.F90. - Made 2 internal optional arguments that were always being used mandatory in thickness_diffuse_full(). - Eliminated the unused deta_tidal_deta argument to calc_tidal_forcing() and made the m_to_Z argument to the same routine mandatory. The former value is instead obtained by a call to tidal_sensitivity. - Eliminated 3 unused arguments and made an optional argument that was always used mandatory for find_deficit_ratios() in MOM_regularize_layers.F90. --- .../lateral/MOM_internal_tides.F90 | 17 ++-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 22 +++--- .../lateral/MOM_thickness_diffuse.F90 | 43 ++++------ .../lateral/MOM_tidal_forcing.F90 | 29 +++---- .../vertical/MOM_regularize_layers.F90 | 78 +++---------------- 5 files changed, 55 insertions(+), 134 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 860b5233c9..2f9bb1f653 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1905,7 +1905,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. - logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean + logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables @@ -1913,15 +1913,14 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) real, parameter :: oneSixth = 1./6. real :: h_ip1, h_im1 real :: dMx, dMn - logical :: use_CW84, use_2nd + logical :: use_CW84 character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil - use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd isl = LB%ish-1 ; iel = LB%ieh+1 ; jsl = LB%jsh ; jel = LB%jeh ! This is the stencil of the reconstruction, not the scheme overall. - stencil = 2 ; if (use_2nd) stencil = 1 + stencil = 2 ; if (simple_2nd) stencil = 1 if ((isl-stencil < G%isd) .or. (iel+stencil > G%ied)) then write(mesg,'("In MOM_internal_tides, PPM_reconstruction_x called with a ", & @@ -1936,7 +1935,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) call MOM_error(FATAL,mesg) endif - if (use_2nd) then + if (simple_2nd) then do j=jsl,jel ; do i=isl,iel h_im1 = G%mask2dT(i-1,j) * h_in(i-1,j) + (1.0-G%mask2dT(i-1,j)) * h_in(i,j) h_ip1 = G%mask2dT(i+1,j) * h_in(i+1,j) + (1.0-G%mask2dT(i+1,j)) * h_in(i,j) @@ -1981,7 +1980,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. - logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean + logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables @@ -1989,15 +1988,13 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) real, parameter :: oneSixth = 1./6. real :: h_jp1, h_jm1 real :: dMx, dMn - logical :: use_2nd character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil - use_2nd = .false. ; if (present(simple_2nd)) use_2nd = simple_2nd isl = LB%ish ; iel = LB%ieh ; jsl = LB%jsh-1 ; jel = LB%jeh+1 ! This is the stencil of the reconstruction, not the scheme overall. - stencil = 2 ; if (use_2nd) stencil = 1 + stencil = 2 ; if (simple_2nd) stencil = 1 if ((isl < G%isd) .or. (iel > G%ied)) then write(mesg,'("In MOM_internal_tides, PPM_reconstruction_y called with a ", & @@ -2012,7 +2009,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) call MOM_error(FATAL,mesg) endif - if (use_2nd) then + if (simple_2nd) then do j=jsl,jel ; do i=isl,iel h_jm1 = G%mask2dT(i,j-1) * h_in(i,j-1) + (1.0-G%mask2dT(i,j-1)) * h_in(i,j) h_jp1 = G%mask2dT(i,j+1) * h_in(i,j+1) + (1.0-G%mask2dT(i,j+1)) * h_in(i,j) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d0df4b81ba..9306233112 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -451,7 +451,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) 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_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. @@ -477,10 +477,10 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) - call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC=OBC) + call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) - call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true., OBC=OBC) + call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true., OBC) endif endif endif @@ -515,7 +515,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C !! at v-points [L2 Z-2 T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real :: S2 ! Interface slope squared [nondim] @@ -543,10 +543,10 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C local_open_u_BC = .false. local_open_v_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_u_BC = OBC%open_u_BCs_exist_globally local_open_v_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif S2max = CS%Visbeck_S_max**2 @@ -673,8 +673,8 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, d type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ocean_OBC_type), pointer, intent(in) :: OBC !< Open boundaries control structure. -real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Interface height [Z ~> m] + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Interface height [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface height [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzu !< dz at u-points [Z ~> m] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: dzv !< dz at v-points [Z ~> m] @@ -859,7 +859,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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. + type(ocean_OBC_type), 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) @@ -890,10 +890,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop local_open_u_BC = .false. local_open_v_BC = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (associated(OBC)) then local_open_u_BC = OBC%open_u_BCs_exist_globally local_open_v_BC = OBC%open_v_BCs_exist_globally - endif ; endif + endif one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index daeb64fab9..78425676b1 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -580,11 +580,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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 + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of !! density gradients [nondim]. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), 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]. @@ -694,7 +694,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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 ! state calculations at u-points. @@ -715,8 +714,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV N2_floor = CS%N2_floor*US%Z_to_L**2 use_EOS = associated(tv%eqn_of_state) - present_int_slope_u = PRESENT(int_slope_u) - present_int_slope_v = PRESENT(int_slope_v) present_slope_x = PRESENT(slope_x) present_slope_y = PRESENT(slope_y) use_Stanley = CS%Stanley_det_coeff >= 0. @@ -818,12 +815,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & -!$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP I_slope_max2,h_neglect2,present_int_slope_u, & -!$OMP int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & -!$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1, & -!$OMP diag_sfn_x, diag_sfn_unlim_x,N2_floor,EOSdom_u, & -!$OMP use_stanley, Tsgs2, & +!$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & +!$OMP h_neglect2,int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & +!$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1,diag_sfn_x, & +!$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,use_stanley, Tsgs2, & !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & @@ -941,11 +936,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Adjust real slope by weights that bias towards slope of interfaces ! that ignore density gradients along layers. - if (present_int_slope_u) then - Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) - slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) - endif + Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & + int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) hN2_x_PE(I,j,k) = hN2_u(I,K) @@ -1090,12 +1083,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Calculate the meridional fluxes and gradients. EOSdom_v(:) = EOS_domain(G%HI) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & -!$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP I_slope_max2,h_neglect2,present_int_slope_v, & -!$OMP int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & -!$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1, & -!$OMP diag_sfn_y,diag_sfn_unlim_y,N2_floor,EOSdom_v,& -!$OMP use_stanley, Tsgs2, & +!$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & +!$OMP h_neglect2,int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & +!$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1,diag_sfn_y, & +!$OMP diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,Tsgs2, & !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & @@ -1211,11 +1202,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Adjust real slope by weights that bias towards slope of interfaces ! that ignore density gradients along layers. - if (present_int_slope_v) then - Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) - slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) - endif + Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & + int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) hN2_y_PE(i,J,k) = hN2_v(i,K) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 862b622d56..0d92a14d2a 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -579,7 +579,7 @@ end subroutine tidal_forcing_sensitivity !! height. For now, eta and eta_tidal are both geopotential heights in depth !! units, but probably the input for eta should really be replaced with the !! column mass anomalies. -subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to_Z) +subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from @@ -588,16 +588,12 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to !! anomalies [Z ~> m]. type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. - real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of - !! eta_tidal with the local value of - !! eta [nondim]. - real, optional, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. + real, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. ! Local variables real :: now ! The relative time in seconds. real :: amp_cosomegat, amp_sinomegat real :: cosomegat, sinomegat - real :: m_Z ! A scaling factor from m to depth units. real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal. integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -622,21 +618,14 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to eta_prop = 0.0 endif - if (present(deta_tidal_deta)) then - deta_tidal_deta = eta_prop - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; eta_tidal(i,j) = 0.0 ; enddo ; enddo - else - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_prop*eta(i,j) - enddo ; enddo - endif - - m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + eta_tidal(i,j) = eta_prop*eta(i,j) + enddo ; enddo do c=1,CS%nc m = CS%struct(c) - amp_cosomegat = m_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) - amp_sinomegat = m_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) + amp_cosomegat = m_to_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) + amp_sinomegat = m_to_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + & amp_sinomegat*CS%sin_struct(i,j,m)) @@ -647,7 +636,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) + m_Z*CS%ampsal(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) + m_to_Z*CS%ampsal(i,j,c) * & (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c)) enddo ; enddo enddo ; endif @@ -656,7 +645,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) - m_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) - m_to_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c)) enddo ; enddo enddo ; endif diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index f67fb48fc7..af92e522a2 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -219,7 +219,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) e(i,j,K+1) = e(i,j,K) - h(i,j,k) enddo ; enddo ; enddo - call find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h=h) + call find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) ! Determine which columns are problematic do j=js,je ; do_j(j) = .false. ; enddo @@ -612,8 +612,7 @@ end subroutine regularize_surface !! thickness at velocity points differ from the arithmetic means, relative to !! the the arithmetic means, after eliminating thickness variations that are !! solely due to topography and aggregating all interior layers into one. -subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & - def_rat_u_2lay, def_rat_v_2lay, halo, h) +subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -626,30 +625,18 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & !! [nondim]. type(regularize_layers_CS), pointer :: CS !< The control structure returned by a !! previous call to regularize_layers_init. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: def_rat_u_2lay !< The thickness deficit ratio at u - !! points when the mixed and buffer layers - !! are aggregated into 1 layer [nondim]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: def_rat_v_2lay !< The thickness deficit ratio at v - !! 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_(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. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & h_def_u, & ! The vertically summed thickness deficits at u-points [H ~> m or kg m-2]. - h_norm_u, & ! The vertically summed arithmetic mean thickness by which + h_norm_u ! The vertically summed arithmetic mean thickness by which ! h_def_u is normalized [H ~> m or kg m-2]. - h_def2_u real, dimension(SZI_(G),SZJB_(G)) :: & h_def_v, & ! The vertically summed thickness deficits at v-points [H ~> m or kg m-2]. - h_norm_v, & ! The vertically summed arithmetic mean thickness by which + h_norm_v ! The vertically summed arithmetic mean thickness by which ! h_def_v is normalized [H ~> m or kg m-2]. - h_def2_v 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 :: Hmix_min ! A local copy of CS%Hmix_min [H ~> m or kg m-2]. @@ -657,9 +644,6 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & integer :: i, j, k, is, ie, js, je, nz, nkmb 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 nkmb = GV%nk_rho_varies h_neglect = GV%H_subroundoff Hmix_min = CS%Hmix_min @@ -677,22 +661,8 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_u(I,j) = 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_u(I,j) = 0.5*(h1+h2) enddo ; enddo - if (present(def_rat_u_2lay)) then ; do j=js,je ; do I=is-1,ie - ! This is a particular metric of the aggregation into two layers. - h1 = e(i,j,1)-e(i,j,nkmb+1) ; h2 = e(i+1,j,1)-e(i+1,j,nkmb+1) - if (e(i,j,nkmb+1) < e(i+1,j,nz+1)) then - if (h1 > h2) h1 = max(e(i,j,1)-e(i+1,j,nz+1), h2) - elseif (e(i+1,j,nkmb+1) < e(i,j,nz+1)) then - if (h2 > h1) h2 = max(e(i+1,j,1)-e(i,j,nz+1), h1) - endif - h_def2_u(I,j) = h_def_u(I,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) - enddo ; enddo ; endif do k=1,nkmb ; do j=js,je ; do I=is-1,ie - if (present(h)) then - h1 = h(i,j,k) ; h2 = h(i+1,j,k) - else - h1 = e(i,j,K)-e(i,j,K+1) ; h2 = e(i+1,j,K)-e(i+1,j,K+1) - endif + h1 = h(i,j,k) ; h2 = h(i+1,j,k) ! Thickness deficits can not arise simply because a layer's bottom is bounded ! by the bathymetry. if (e(i,j,K+1) < e(i+1,j,nz+1)) then @@ -703,15 +673,10 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_u(I,j) = h_def_u(I,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_u(I,j) = h_norm_u(I,j) + 0.5*(h1+h2) enddo ; enddo ; enddo - if (present(def_rat_u_2lay)) then ; do j=js,je ; do I=is-1,ie - def_rat_u(I,j) = G%mask2dCu(I,j) * h_def_u(I,j) / & - (max(Hmix_min, h_norm_u(I,j)) + h_neglect) - def_rat_u_2lay(I,j) = G%mask2dCu(I,j) * h_def2_u(I,j) / & - (max(Hmix_min, h_norm_u(I,j)) + h_neglect) - enddo ; enddo ; else ; do j=js,je ; do I=is-1,ie + do j=js,je ; do I=is-1,ie def_rat_u(I,j) = G%mask2dCu(I,j) * h_def_u(I,j) / & (max(Hmix_min, h_norm_u(I,j)) + h_neglect) - enddo ; enddo ; endif + enddo ; enddo ! Determine which meridional faces are problematic. do J=js-1,je ; do i=is,ie @@ -726,22 +691,8 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_v(i,J) = 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_v(i,J) = 0.5*(h1+h2) enddo ; enddo - if (present(def_rat_v_2lay)) then ; do J=js-1,je ; do i=is,ie - ! This is a particular metric of the aggregation into two layers. - h1 = e(i,j,1)-e(i,j,nkmb+1) ; h2 = e(i,j+1,1)-e(i,j+1,nkmb+1) - if (e(i,j,nkmb+1) < e(i,j+1,nz+1)) then - if (h1 > h2) h1 = max(e(i,j,1)-e(i,j+1,nz+1), h2) - elseif (e(i,j+1,nkmb+1) < e(i,j,nz+1)) then - if (h2 > h1) h2 = max(e(i,j+1,1)-e(i,j,nz+1), h1) - endif - h_def2_v(i,J) = h_def_v(i,J) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) - enddo ; enddo ; endif do k=1,nkmb ; do J=js-1,je ; do i=is,ie - if (present(h)) then - h1 = h(i,j,k) ; h2 = h(i,j+1,k) - else - h1 = e(i,j,K)-e(i,j,K+1) ; h2 = e(i,j+1,K)-e(i,j+1,K+1) - endif + h1 = h(i,j,k) ; h2 = h(i,j+1,k) ! Thickness deficits can not arise simply because a layer's bottom is bounded ! by the bathymetry. if (e(i,j,K+1) < e(i,j+1,nz+1)) then @@ -752,15 +703,10 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def_v(i,J) = h_def_v(i,J) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect) h_norm_v(i,J) = h_norm_v(i,J) + 0.5*(h1+h2) enddo ; enddo ; enddo - if (present(def_rat_v_2lay)) then ; do J=js-1,je ; do i=is,ie - def_rat_v(i,J) = G%mask2dCv(i,J) * h_def_v(i,J) / & - (max(Hmix_min, h_norm_v(i,J)) + h_neglect) - def_rat_v_2lay(i,J) = G%mask2dCv(i,J) * h_def2_v(i,J) / & - (max(Hmix_min, h_norm_v(i,J)) + h_neglect) - enddo ; enddo ; else ; do J=js-1,je ; do i=is,ie + do J=js-1,je ; do i=is,ie def_rat_v(i,J) = G%mask2dCv(i,J) * h_def_v(i,J) / & (max(Hmix_min, h_norm_v(i,J)) + h_neglect) - enddo ; enddo ; endif + enddo ; enddo end subroutine find_deficit_ratios From c053fdcb063c0bc6cc08263c82fc11d30573185b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 25 Oct 2021 10:18:17 -0400 Subject: [PATCH 021/138] cpu_clock_id: synchro_flag arg changed to logical This patch modifies the `cpu_clock_id` interface so that the `synchro_flag` argument is converted into a platform-agnostic logical flag. The current implementation requires the synchronization flag to be defined using FMS norms (zero-bit) and also would force users to follow FMS predefined flags for other values. This patch changes the sync flag to a logical, and modifies the default flag to enable synced clocks (based on `clock_flag_default`). `synchro_flag` is also renamed to `sync` for simplicity. --- config_src/infra/FMS1/MOM_cpu_clock_infra.F90 | 25 ++++++++++--------- config_src/infra/FMS2/MOM_cpu_clock_infra.F90 | 25 ++++++++++--------- 2 files changed, 26 insertions(+), 24 deletions(-) diff --git a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 index 47d7bbedaa..62c21e5772 100644 --- a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 @@ -71,23 +71,24 @@ subroutine cpu_clock_end(id) end subroutine cpu_clock_end !> Returns the integer handle for a named CPU clock. -integer function cpu_clock_id( name, synchro_flag, grain ) +integer function cpu_clock_id(name, sync, grain) character(len=*), intent(in) :: name !< The unique name of the CPU clock - integer, optional, intent(in) :: synchro_flag !< An integer flag that controls whether the PEs - !! are synchronized before the cpu clocks start counting. - !! Synchronization occurs before the start of a clock if this - !! is odd, while additional (expensive) statistics can set - !! for other values. If absent, the default is taken from the - !! settings for FMS. + logical, optional, intent(in) :: sync !< A flag that controls whether the + !! PEs are synchronized before the cpu clocks start counting. + !! Synchronization occurs before the start of a clock if this + !! is enabled, while additional (expensive) statistics can + !! set for other values. + !! If absent, the default is taken from the settings for FMS. integer, optional, intent(in) :: grain !< The timing granularity for this clock, usually set to !! the values of CLOCK_COMPONENT, CLOCK_ROUTINE, CLOCK_LOOP, etc. - if (present(synchro_flag)) then - cpu_clock_id = mpp_clock_id(name, flags=synchro_flag, grain=grain) - else - cpu_clock_id = mpp_clock_id(name, flags=clock_flag_default, grain=grain) - endif + integer :: clock_flags + clock_flags = clock_flag_default + if (present(sync)) & + clock_flags = ibset(clock_flags, 0) + + cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id end module MOM_cpu_clock_infra diff --git a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 index 47d7bbedaa..62c21e5772 100644 --- a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 @@ -71,23 +71,24 @@ subroutine cpu_clock_end(id) end subroutine cpu_clock_end !> Returns the integer handle for a named CPU clock. -integer function cpu_clock_id( name, synchro_flag, grain ) +integer function cpu_clock_id(name, sync, grain) character(len=*), intent(in) :: name !< The unique name of the CPU clock - integer, optional, intent(in) :: synchro_flag !< An integer flag that controls whether the PEs - !! are synchronized before the cpu clocks start counting. - !! Synchronization occurs before the start of a clock if this - !! is odd, while additional (expensive) statistics can set - !! for other values. If absent, the default is taken from the - !! settings for FMS. + logical, optional, intent(in) :: sync !< A flag that controls whether the + !! PEs are synchronized before the cpu clocks start counting. + !! Synchronization occurs before the start of a clock if this + !! is enabled, while additional (expensive) statistics can + !! set for other values. + !! If absent, the default is taken from the settings for FMS. integer, optional, intent(in) :: grain !< The timing granularity for this clock, usually set to !! the values of CLOCK_COMPONENT, CLOCK_ROUTINE, CLOCK_LOOP, etc. - if (present(synchro_flag)) then - cpu_clock_id = mpp_clock_id(name, flags=synchro_flag, grain=grain) - else - cpu_clock_id = mpp_clock_id(name, flags=clock_flag_default, grain=grain) - endif + integer :: clock_flags + clock_flags = clock_flag_default + if (present(sync)) & + clock_flags = ibset(clock_flags, 0) + + cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id end module MOM_cpu_clock_infra From aad1e891db595a1a6a15203e0e079439867d75df Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 29 Oct 2021 06:46:20 -0400 Subject: [PATCH 022/138] Eliminate GET_ALL_PARAMS in hor_visc_init (#1536) * Eliminate GET_ALL_PARAMS in hor_visc_init Added do_not_log arguments to get_param calls in MOM_hor_visc.F90 that are only used conditionally, and eliminated the unlogged GET_ALL_PARAMS runtime parameter and get_all variable in hor_visc_init(). By design, all logging of parameters after this commit is identical to before, even for variables that are inactive and therefore should not be logged. In several places, there were some problems, mostly with the GME code, that have been noted in comments marked with '###'. Also cleaned up the code alignment and eliminated unneeded temporary variables in a few places in hor_visc(). All solutions are bitwise identical, and no output is changed. * Restore temporary variables Undid changes that eliminated temporary variables to facilitate performance profiling, and restored the "Knuth" convention about the placement of the line breaks relative to "+" in these expressions. Nothing changes. --- .../lateral/MOM_hor_visc.F90 | 335 +++++++++--------- 1 file changed, 170 insertions(+), 165 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 15e8415474..db2514576d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -819,7 +819,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) Del2vort_q(I,J) = DY_dxBu * (vort_xy_dx(i+1,J) * G%IdyCv(i+1,J) - vort_xy_dx(i,J) * G%IdyCv(i,J)) + & - DX_dyBu * (vort_xy_dy(I,j+1) * G%IdyCu(I,j+1) - vort_xy_dy(I,j) * G%IdyCu(I,j)) + DX_dyBu * (vort_xy_dy(I,j+1) * G%IdyCu(I,j+1) - vort_xy_dy(I,j) * G%IdyCu(I,j)) enddo ; enddo do J=Jsq,Jeq+1 ; do I=Isq,Ieq+1 Del2vort_h(i,j) = 0.25*(Del2vort_q(I,J) + Del2vort_q(I-1,J) + Del2vort_q(I,J-1) + Del2vort_q(I-1,J-1)) @@ -837,12 +837,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Magnitude of divergence gradient do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - grad_div_mag_h(i,j) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) + grad_div_mag_h(i,j) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & + (0.5*(div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) enddo ; enddo do j=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+1 - grad_div_mag_q(I,J) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) + grad_div_mag_q(I,J) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & + (0.5*(div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) enddo ; enddo else @@ -902,11 +902,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - sh_xx_sq = sh_xx(i,j) * sh_xx(i,j) - sh_xy_sq = 0.25 * ( & - (sh_xy(I-1,J-1) * sh_xy(I-1,J-1) + sh_xy(I,J) * sh_xy(I,J)) & - + (sh_xy(I-1,J) * sh_xy(I-1,J) + sh_xy(I,J-1) * sh_xy(I,J-1)) & - ) + sh_xx_sq = sh_xx(i,j)**2 + sh_xy_sq = 0.25 * ( (sh_xy(I-1,J-1)**2 + sh_xy(I,J)**2) & + + (sh_xy(I-1,J)**2 + sh_xy(I,J-1)**2) ) Shear_mag(i,j) = sqrt(sh_xx_sq + sh_xy_sq) enddo ; enddo endif @@ -1184,12 +1182,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then do J=js-1,Jeq ; do I=is-1,Ieq - sh_xy_sq = sh_xy(I,J) * sh_xy(I,J) - sh_xx_sq = 0.25 * ( & - (sh_xx(i,j) * sh_xx(i,j) + sh_xx(i+1,j+1) * sh_xx(i+1,j+1)) & - + (sh_xx(i,j+1) * sh_xx(i,j+1) + sh_xx(i+1,j) * sh_xx(i+1,j)) & - ) - Shear_mag(i,j) = sqrt(sh_xy_sq + sh_xx_sq) + sh_xy_sq = sh_xy(I,J)**2 + sh_xx_sq = 0.25 * ( (sh_xx(i,j)**2 + sh_xx(i+1,j+1)**2) & + + (sh_xx(i,j+1)**2 + sh_xx(i+1,j)**2) ) + Shear_mag(I,J) = sqrt(sh_xy_sq + sh_xx_sq) enddo ; enddo endif @@ -1434,6 +1430,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%use_GME) then + !### This call to get the 3-d GME diffusivity arrays and the subsequent blocking halo update + ! should occur outside of the k-loop, and perhaps the halo update should occur outside of + ! this routine altogether! 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) @@ -1458,6 +1457,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo ! Applying GME diagonal term. This is linear and the arguments can be rescaled. + !### This smoothing is only applied at computational grid points, but is used in extra halo points! + !### There are blocking halo updates in the smooth_GME routines, which could be avoided by expanding + ! the loop ranges by a point in the code setting str_xx_GME and str_xy_GME a few lines above. call smooth_GME(CS, G, GME_flux_h=str_xx_GME) call smooth_GME(CS, G, GME_flux_q=str_xy_GME) @@ -1809,9 +1811,6 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS - logical :: get_all ! If true, read and log all parameters, regardless of - ! whether they are used, to enable spell-checking of - ! valid parameters. logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. logical :: use_MEKE ! If true, the MEKE parameterization is in use. @@ -1824,8 +1823,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB integer :: i, j -! 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_hor_visc" ! module name 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 @@ -1840,22 +1839,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) CS%diag => diag ! Read parameters and write them to the model log. call log_version(param_file, mdl, version, "") - ! It is not clear whether all of these initialization lines are needed for the - ! cases where the corresponding parameters are not read. - CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. - CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false. - CS%use_QG_Leith_visc = .false. - CS%bound_Coriolis = .false. - CS%Modified_Leith = .false. - CS%dynamic_aniso = .false. - Kh = 0.0 ; Ah = 0.0 - ! These initialization lines are needed because they are used even in cases where they are not read. - CS%anisotropic = .false. - CS%res_scale_MEKE = .false. - - ! If GET_ALL_PARAMS is true, all parameters are read in all cases to enable - ! parameter spelling checks. - call get_param(param_file, mdl, "GET_ALL_PARAMS", get_all, default=.false.) + + ! All parameters are read in all cases to enable parameter spelling checks. call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false.) @@ -1867,185 +1852,202 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) - if (CS%Laplacian .or. get_all) then - call get_param(param_file, mdl, "KH", Kh, & + + call get_param(param_file, mdl, "KH", Kh, & "The background Laplacian horizontal viscosity.", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & "The minimum value allowed for Laplacian horizontal viscosity, KH.", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & "The velocity scale which is multiplied by the grid "//& "spacing to calculate the Laplacian viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and KH.", & - units="m s-1", default=0.0, scale=US%m_s_to_L_T) - call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & + units="m s-1", default=0.0, scale=US%m_s_to_L_T, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & "The amplitude of a latitudinally-dependent background "//& "viscosity of the form KH_SIN_LAT*(SIN(LAT)**KH_PWR_OF_SINE).", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - if (Kh_sin_lat>0. .or. get_all) & - call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & "The power used to raise SIN(LAT) when using a latitudinally "//& "dependent background viscosity.", & - units = "nondim", default=4.0) - call get_param(param_file, mdl, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & + units="nondim", default=4.0, & + do_not_log=.not.(CS%Laplacian .and. (Kh_sin_lat>0.)) ) + call get_param(param_file, mdl, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & "If true, use a Smagorinsky nonlinear eddy viscosity.", & - default=.false.) - if (CS%Smagorinsky_Kh .or. get_all) & - call get_param(param_file, mdl, "SMAG_LAP_CONST", Smag_Lap_const, & + default=.false., do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%Smagorinsky_Kh = .false. + call get_param(param_file, mdl, "SMAG_LAP_CONST", Smag_Lap_const, & "The nondimensional Laplacian Smagorinsky constant, "//& "often 0.15.", units="nondim", default=0.0, & - fail_if_missing = CS%Smagorinsky_Kh) - call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & + fail_if_missing=CS%Smagorinsky_Kh, do_not_log=.not.CS%Smagorinsky_Kh) + call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & "If true, use a Leith nonlinear eddy viscosity.", & - default=.false.) - ! This call duplicates one that occurs 26 lines later, and is probably unneccessary. - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & + default=.false., do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%Leith_Kh = .false. + ! This call duplicates one that occurs 26 lines later, and is probably unneccessary. + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & "If true, add a term to Leith viscosity which is "//& "proportional to the gradient of divergence.", & - default=.false.) - call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & + default=.false., do_not_log=.not.CS%Laplacian) !### (.not.CS%Leith_Kh)? + call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & + call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & "If true, the viscosity contribution from MEKE is scaled by "//& - "the resolution function.", default=.false., do_not_log=.not.use_MEKE) - if (.not.use_MEKE) CS%res_scale_MEKE = .false. - if (CS%Leith_Kh .or. get_all) then - call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & + "the resolution function.", default=.false., & + do_not_log=.not.(CS%Laplacian.and.use_MEKE)) + if (.not.(CS%Laplacian.and.use_MEKE)) CS%res_scale_MEKE = .false. + + call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & "The nondimensional Laplacian Leith constant, "//& "often set to 1.0", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Kh) - call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & + fail_if_missing=CS%Leith_Kh, do_not_log=.not.CS%Leith_Kh) + call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & "If true, use QG Leith nonlinear eddy viscosity.", & - default=.false.) - if (CS%use_QG_Leith_visc .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & + default=.false., do_not_log=.not.CS%Leith_Kh) + if (CS%use_QG_Leith_visc .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & "MOM_hor_visc.F90, hor_visc_init:"//& "LEITH_KH must be True when USE_QG_LEITH_VISC=True.") - endif - if (CS%Leith_Kh .or. CS%Leith_Ah .or. get_all) then - call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & + + !### The following two get_param_calls need to occur after Leith_Ah is read, but for now it replciates prior code. + CS%Leith_Ah = .false. + call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & "If true, include the beta term in the Leith nonlinear eddy viscosity.", & - default=CS%Leith_Kh) - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & + default=CS%Leith_Kh, do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & "If true, add a term to Leith viscosity which is "//& "proportional to the gradient of divergence.", & - default=.false.) - endif - call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & + default=.false., do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + + call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & "If true, the Laplacian coefficient is locally limited "//& - "to be stable.", default=.true.) - call get_param(param_file, mdl, "BETTER_BOUND_KH", CS%better_bound_Kh, & + "to be stable.", default=.true., do_not_log=.not.CS%Laplacian) + call get_param(param_file, mdl, "BETTER_BOUND_KH", CS%better_bound_Kh, & "If true, the Laplacian coefficient is locally limited "//& "to be stable with a better bounding than just BOUND_KH.", & - default=CS%bound_Kh) - call get_param(param_file, mdl, "ANISOTROPIC_VISCOSITY", CS%anisotropic, & + default=CS%bound_Kh, do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%bound_Kh = .false. + if (.not.CS%Laplacian) CS%better_bound_Kh = .false. + call get_param(param_file, mdl, "ANISOTROPIC_VISCOSITY", CS%anisotropic, & "If true, allow anistropic viscosity in the Laplacian "//& - "horizontal viscosity.", default=.false.) - call get_param(param_file, mdl, "ADD_LES_VISCOSITY", CS%add_LES_viscosity, & + "horizontal viscosity.", default=.false., & + do_not_log=.not.CS%Laplacian) + if (.not.CS%Laplacian) CS%anisotropic = .false. ! This replicates the prior code, but is it intended? + call get_param(param_file, mdl, "ADD_LES_VISCOSITY", CS%add_LES_viscosity, & "If true, adds the viscosity from Smagorinsky and Leith to the "//& - "background viscosity instead of taking the maximum.", default=.false.) - endif - if (CS%anisotropic .or. get_all) then - call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, & + "background viscosity instead of taking the maximum.", default=.false., & + do_not_log=.not.CS%Laplacian) + + call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, & "The background Laplacian anisotropic horizontal viscosity.", & - units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) - call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & + do_not_log=.not.CS%anisotropic) + call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & "Selects the mode for setting the direction of anistropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& "\t 1 - Points towards East.\n"//& "\t 2 - Points along the flow direction, U/|U|.", & - default=0) - select case (aniso_mode) - case (0) - call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for "//& - "horizont viscosity. n1,n2 are the i,j components relative "//& - "to the grid.", units = "nondim", fail_if_missing=.true.) - case (1) - call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for "//& - "horizont viscosity. n1,n2 are the i,j components relative "//& - "to the spherical coordinates.", units = "nondim", fail_if_missing=.true.) - end select + default=0, do_not_log=.not.CS%anisotropic) + if (aniso_mode == 0) then + call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & + "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "n1,n2 are the i,j components relative to the grid.", & + units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) + elseif (aniso_mode == 1) then + call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & + "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "n1,n2 are the i,j components relative to the spherical coordinates.", & + units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) + else + call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & + "The vector pointing in the direction of anistropy for horizontal viscosity.", & + units="nondim", fail_if_missing=.false., do_not_log=.true.) endif + call get_param(param_file, mdl, "BIHARMONIC", CS%biharmonic, & "If true, use a biharmonic horizontal viscosity. "//& "BIHARMONIC may be used with LAPLACIAN.", & default=.true.) - if (CS%biharmonic .or. get_all) then - call get_param(param_file, mdl, "AH", Ah, & + call get_param(param_file, mdl, "AH", Ah, & "The background biharmonic horizontal viscosity.", & - units = "m4 s-1", default=0.0, scale=US%m_to_L**4*US%T_to_s) - call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & + units="m4 s-1", default=0.0, scale=US%m_to_L**4*US%T_to_s, & + do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & "The velocity scale which is multiplied by the cube of "//& "the grid spacing to calculate the biharmonic viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & - units="m s-1", default=0.0, scale=US%m_s_to_L_T) - call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & + units="m s-1", default=0.0, scale=US%m_s_to_L_T, do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & "A time scale whose inverse is multiplied by the fourth "//& "power of the grid spacing to calculate biharmonic viscosity. "//& "The final viscosity is the largest of all viscosity "//& "formulations in use. 0.0 means that it's not used.", & - units="s", default=0.0, scale=US%s_to_T) - call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & + units="s", default=0.0, scale=US%s_to_T, do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy "//& - "viscosity.", default=.false.) - call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & + "viscosity.", default=.false., do_not_log=.not.CS%biharmonic) + if (.not.CS%biharmonic) CS%Smagorinsky_Ah = .false. + call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & "If true, use a biharmonic Leith nonlinear eddy "//& - "viscosity.", default=.false.) - call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & + "viscosity.", default=.false., do_not_log=.not.CS%biharmonic) + if (.not.CS%biharmonic) CS%Leith_Ah = .false. + call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & "If true, the biharmonic coefficient is locally limited "//& - "to be stable.", default=.true.) - call get_param(param_file, mdl, "BETTER_BOUND_AH", CS%better_bound_Ah, & + "to be stable.", default=.true., do_not_log=.not.CS%biharmonic) + call get_param(param_file, mdl, "BETTER_BOUND_AH", CS%better_bound_Ah, & "If true, the biharmonic coefficient is locally limited "//& "to be stable with a better bounding than just BOUND_AH.", & - default=CS%bound_Ah) - call get_param(param_file, mdl, "RE_AH", CS%Re_Ah, & + default=CS%bound_Ah, do_not_log=.not.CS%biharmonic) + if (.not.CS%biharmonic) CS%bound_Ah = .false. + if (.not.CS%biharmonic) CS%better_bound_Ah = .false. + call get_param(param_file, mdl, "RE_AH", CS%Re_Ah, & "If nonzero, the biharmonic coefficient is scaled "//& "so that the biharmonic Reynolds number is equal to this.", & - units="nondim", default=0.0) + units="nondim", default=0.0, do_not_log=.not.CS%biharmonic) - if (CS%Smagorinsky_Ah .or. get_all) then - call get_param(param_file, mdl, "SMAG_BI_CONST",Smag_bi_const, & + call get_param(param_file, mdl, "SMAG_BI_CONST",Smag_bi_const, & "The nondimensional biharmonic Smagorinsky constant, "//& "typically 0.015 - 0.06.", units="nondim", default=0.0, & - fail_if_missing = CS%Smagorinsky_Ah) - call get_param(param_file, mdl, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) - call get_param(param_file, mdl, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & + fail_if_missing=CS%Smagorinsky_Ah, do_not_log=.not.CS%Smagorinsky_Ah) + + call get_param(param_file, mdl, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) + call get_param(param_file, mdl, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & "If true use a viscosity that increases with the square "//& "of the velocity shears, so that the resulting viscous "//& "drag is of comparable magnitude to the Coriolis terms "//& "when the velocity differences between adjacent grid "//& "points is 0.5*BOUND_CORIOLIS_VEL. The default is the "//& - "value of BOUND_CORIOLIS (or false).", default=bound_Cor_def) - if (CS%bound_Coriolis .or. get_all) then - call get_param(param_file, mdl, "MAXVEL", maxvel, default=3.0e8) - bound_Cor_vel = maxvel - call get_param(param_file, mdl, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & + "value of BOUND_CORIOLIS (or false).", default=bound_Cor_def, & + do_not_log=.not.CS%Smagorinsky_Ah) + if (.not.CS%Smagorinsky_Ah) CS%bound_Coriolis = .false. + call get_param(param_file, mdl, "MAXVEL", maxvel, default=3.0e8) + call get_param(param_file, mdl, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & "The velocity scale at which BOUND_CORIOLIS_BIHARM causes "//& "the biharmonic drag to have comparable magnitude to the "//& "Coriolis acceleration. The default is set by MAXVEL.", & - units="m s-1", default=maxvel, scale=US%m_s_to_L_T) - endif - endif - if (CS%Leith_Ah .or. get_all) & - call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & + units="m s-1", default=maxvel, scale=US%m_s_to_L_T, & + do_not_log=.not.(CS%Smagorinsky_Ah .and. CS%bound_Coriolis)) + + call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & "The nondimensional biharmonic Leith constant, "//& "typical values are thus far undetermined.", units="nondim", default=0.0, & - fail_if_missing = CS%Leith_Ah) - endif + fail_if_missing=CS%Leith_Ah, do_not_log=.not.CS%Leith_Ah) + call get_param(param_file, mdl, "USE_LAND_MASK_FOR_HVISC", CS%use_land_mask, & "If true, use Use the land mask for the computation of thicknesses "//& "at velocity locations. This eliminates the dependence on arbitrary "//& "values over land or outside of the domain.", default=.true.) - if (CS%better_bound_Ah .or. CS%better_bound_Kh .or. get_all) & - call get_param(param_file, mdl, "HORVISC_BOUND_COEF", CS%bound_coef, & + call get_param(param_file, mdl, "HORVISC_BOUND_COEF", CS%bound_coef, & "The nondimensional coefficient of the ratio of the "//& "viscosity bounds to the theoretical maximum for "//& "stability without considering other terms.", units="nondim", & - default=0.8) + default=0.8, do_not_log=.not.(CS%better_bound_Ah .or. CS%better_bound_Kh)) call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & "If true, no slip boundary conditions are used; otherwise "//& "free slip boundary conditions are assumed. The "//& @@ -2056,34 +2058,31 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) call get_param(param_file, mdl, "USE_KH_BG_2D", CS%use_Kh_bg_2d, & "If true, read a file containing 2-d background harmonic "//& "viscosities. The final viscosity is the maximum of the other "//& - "terms and this background value.", default=.false.) - if (CS%use_Kh_bg_2d) then - call get_param(param_file, mdl, "KH_BG_2D_BUG", CS%Kh_bg_2d_bug, & + "terms and this background value.", default=.false.) ! ###do_not_log=.not.CS%Laplacian? + call get_param(param_file, mdl, "KH_BG_2D_BUG", CS%Kh_bg_2d_bug, & "If true, retain an answer-changing horizontal indexing bug in setting "//& "the corner-point viscosities when USE_KH_BG_2D=True. This is"//& - "not recommended.", default=.false.) - endif + "not recommended.", default=.false., do_not_log=.not.CS%use_Kh_bg_2d) call get_param(param_file, mdl, "USE_GME", CS%use_GME, & "If true, use the GM+E backscatter scheme in association \n"//& "with the Gent and McWilliams parameterization.", default=.false.) - if (CS%use_GME) then - call get_param(param_file, mdl, "SPLIT", split, & - "Use the split time stepping if true.", default=.true., & - do_not_log=.true.) - if (.not. split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & + call get_param(param_file, mdl, "SPLIT", split, & + "Use the split time stepping if true.", default=.true., do_not_log=.true.) + if (CS%use_GME .and. .not.split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & "cannot be used with SPLIT=False.") - call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & + call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & "The strength of GME tapers quadratically to zero when the bathymetric "//& - "depth is shallower than GME_H0.", units="m", scale=US%m_to_Z, & - default=1000.0) - call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & + "depth is shallower than GME_H0.", & + units="m", scale=US%m_to_Z, default=1000.0, do_not_log=.not.CS%use_GME) + call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & "The nondimensional prefactor multiplying the GME coefficient.", & - units="nondim", default=1.0) - call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & + units="nondim", default=1.0, do_not_log=.not.CS%use_GME) + call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & "The absolute maximum value the GME coefficient is allowed to take.", & - units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7) - endif + units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7, & + do_not_log=.not.CS%use_GME) + if (CS%Laplacian .or. CS%biharmonic) then call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T, & @@ -2128,6 +2127,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) endif ALLOC_(CS%reduction_xx(isd:ied,jsd:jed)) ; CS%reduction_xx(:,:) = 0.0 ALLOC_(CS%reduction_xy(IsdB:IedB,JsdB:JedB)) ; CS%reduction_xy(:,:) = 0.0 + + CS%dynamic_aniso = .false. if (CS%anisotropic) then ALLOC_(CS%n1n2_h(isd:ied,jsd:jed)) ; CS%n1n2_h(:,:) = 0.0 ALLOC_(CS%n1n1_m_n2n2_h(isd:ied,jsd:jed)) ; CS%n1n1_m_n2n2_h(:,:) = 0.0 @@ -2145,13 +2146,14 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) "Runtime parameter ANISOTROPIC_MODE is out of range.") end select endif - if (CS%use_Kh_bg_2d) then - ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 - call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & + + call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & 'The filename containing a 2d map of "Kh".', & - default='KH_background_2d.nc') + default='KH_background_2d.nc', do_not_log=.not.CS%use_Kh_bg_2d) + if (CS%use_Kh_bg_2d) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) + ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) @@ -2579,8 +2581,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) cmor_field_name='dispkexyfo', & cmor_long_name='Depth integrated ocean kinetic energy dissipation due to lateral friction',& cmor_standard_name='ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction') - if (CS%Laplacian .or. get_all) then - endif + end subroutine hor_visc_init !> Calculates factors in the anisotropic orientation tensor to be align with the grid. @@ -2618,8 +2619,9 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) do s=1,1 ! Update halos if (present(GME_flux_h)) then + !### Work on a wider halo to eliminate this blocking send! call pass_var(GME_flux_h, G%Domain) - GME_flux_h_original = GME_flux_h + GME_flux_h_original(:,:) = GME_flux_h(:,:) ! apply smoothing on GME do j = G%jsc, G%jec do i = G%isc, G%iec @@ -2631,6 +2633,7 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) ws = 0.125 * G%mask2dT(i,j-1) wn = 0.125 * G%mask2dT(i,j+1) wc = 1.0 - (ww+we+wn+ws) + !### Add parentheses to make this rotationally invariant. GME_flux_h(i,j) = wc * GME_flux_h_original(i,j) & + ww * GME_flux_h_original(i-1,j) & + we * GME_flux_h_original(i+1,j) & @@ -2641,8 +2644,9 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) endif ! Update halos if (present(GME_flux_q)) then + !### Work on a wider halo to eliminate this blocking send! call pass_var(GME_flux_q, G%Domain, position=CORNER, complete=.true.) - GME_flux_q_original = GME_flux_q + GME_flux_q_original(:,:) = GME_flux_q(:,:) ! apply smoothing on GME do J = G%JscB, G%JecB do I = G%IscB, G%IecB @@ -2654,6 +2658,7 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) ws = 0.125 * G%mask2dBu(I,J-1) wn = 0.125 * G%mask2dBu(I,J+1) wc = 1.0 - (ww+we+wn+ws) + !### Add parentheses to make this rotationally invariant. GME_flux_q(I,J) = wc * GME_flux_q_original(I,J) & + ww * GME_flux_q_original(I-1,J) & + we * GME_flux_q_original(I+1,J) & From 1324656a6d146d06a7792b54aa4b3e5208a66419 Mon Sep 17 00:00:00 2001 From: Nora Loose Date: Fri, 5 Nov 2021 11:32:55 -0600 Subject: [PATCH 023/138] Add weighted d[uv]_dt_str diagnostics (#1539) This adds four new diagnostics building on the wind stress acceleration diagnostics du_dt_str, dv_dt_str (from #1437) - their thickness-weighted versions: h_du_dt_str, h_dv_dt_str (completing the set of diags from 3D thickness x momentum diagnostics #1398) - their viscous remnant fraction: du_dt_str_visc_rem, dv_dt_str_visc_rem (completing the set of diags from Visc_rem_[uv] multiplied momentum budget diagnostics ocean-eddy-cpt/MOM6#10) Nora did some quick tests with the CPT NeverWorld2 setup, which confirm that online and offline multiplication by 1) h or 2) visc_rem_[uv] coincide (up to 1) interpolation error and 2) numerical noise, respectively), and illustrated this beautifully with some figures that accompanied the first of the three commits that were squashed into one. --- .../vertical/MOM_vert_friction.F90 | 76 +++++++++++++++++++ 1 file changed, 76 insertions(+) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index f9512d8c06..d0d3943a26 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -128,6 +128,8 @@ module MOM_vert_friction ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 integer :: id_h_du_dt_visc = -1, id_h_dv_dt_visc = -1 integer :: id_hf_du_dt_visc_2d = -1, id_hf_dv_dt_visc_2d = -1 + integer :: id_h_du_dt_str = -1, id_h_dv_dt_str = -1 + integer :: id_du_dt_str_visc_rem = -1, id_dv_dt_str_visc_rem = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure @@ -219,6 +221,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real, allocatable, dimension(:,:,:) :: h_du_dt_visc ! h x du_dt_visc [H L T-2 ~> m2 s-2] real, allocatable, dimension(:,:,:) :: h_dv_dt_visc ! h x dv_dt_visc [H L T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: h_du_dt_str ! h x du_dt_str [H L T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: h_dv_dt_str ! h x dv_dt_str [H L T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: du_dt_str_visc_rem ! du_dt_str x visc_rem_u [L T-2 ~> m s-2] + real, allocatable, dimension(:,:,:) :: dv_dt_str_visc_rem ! dv_dt_str x visc_rem_v [L T-2 ~> m s-2] logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -565,6 +571,44 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & deallocate(h_dv_dt_visc) endif + if (CS%id_h_du_dt_str > 0) then + allocate(h_du_dt_str(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) + h_du_dt_str(:,:,:) = 0.0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + h_du_dt_str(I,j,k) = ADp%du_dt_str(I,j,k) * ADp%diag_hu(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_h_du_dt_str, h_du_dt_str, CS%diag) + deallocate(h_du_dt_str) + endif + if (CS%id_h_dv_dt_str > 0) then + allocate(h_dv_dt_str(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) + h_dv_dt_str(:,:,:) = 0.0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + h_dv_dt_str(i,J,k) = ADp%dv_dt_str(i,J,k) * ADp%diag_hv(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_h_dv_dt_str, h_dv_dt_str, CS%diag) + deallocate(h_dv_dt_str) + endif + + if (CS%id_du_dt_str_visc_rem > 0) then + allocate(du_dt_str_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) + du_dt_str_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + du_dt_str_visc_rem(I,j,k) = ADp%du_dt_str(I,j,k) * ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_du_dt_str_visc_rem, du_dt_str_visc_rem, CS%diag) + deallocate(du_dt_str_visc_rem) + endif + if (CS%id_dv_dt_str_visc_rem > 0) then + allocate(dv_dt_str_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) + dv_dt_str_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + dv_dt_str_visc_rem(i,J,k) = ADp%dv_dt_str(i,J,k) * ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_dv_dt_str_visc_rem, dv_dt_str_visc_rem, CS%diag) + deallocate(dv_dt_str_visc_rem) + endif + end subroutine vertvisc !> Calculate the fraction of momentum originally in a layer that remains in the water column @@ -1914,6 +1958,38 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) endif + CS%id_h_du_dt_str = register_diag_field('ocean_model', 'h_du_dt_str', diag%axesCuL, Time, & + 'Thickness Multiplied Zonal Acceleration from Surface Wind Stresses', 'm2 s-2', & + conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_du_dt_str > 0) then + call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + endif + + CS%id_h_dv_dt_str = register_diag_field('ocean_model', 'h_dv_dt_str', diag%axesCvL, Time, & + 'Thickness Multiplied Meridional Acceleration from Surface Wind Stresses', 'm2 s-2', & + conversion=GV%H_to_m*US%L_T2_to_m_s2) + if (CS%id_h_dv_dt_str > 0) then + call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) + call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) + endif + + CS%id_du_dt_str_visc_rem = register_diag_field('ocean_model', 'du_dt_str_visc_rem', diag%axesCuL, Time, & + 'Zonal Acceleration from Surface Wind Stresses multiplied by viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_du_dt_str_visc_rem > 0) then + call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + endif + + CS%id_dv_dt_str_visc_rem = register_diag_field('ocean_model', 'dv_dt_str_visc_rem', diag%axesCvL, Time, & + 'Meridional Acceleration from Surface Wind Stresses multiplied by viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_dv_dt_str_visc_rem > 0) then + call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) + call safe_alloc_ptr(ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + endif + if ((len_trim(CS%u_trunc_file) > 0) .or. (len_trim(CS%v_trunc_file) > 0)) & call PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS%PointAccel_CSp) From f2e998339d857d4187841cc0fa1967cf091d0236 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 22 Oct 2021 16:20:10 -0400 Subject: [PATCH 024/138] +Argument cleanup in vertical diffusivity code Cleaned up 26 falsely optional or unused arguments in the vertical diffusivity code, and related changes. Several descriptive comments were also corrected, including the correction of the units of 10 variables related to CVMix_KPP. This commit includes: - Made the Kd_int arguments to set_diffusivity() and 3 subsidiary routines mandatory and reordered the arguments so that the non-optional arguments come before the grid types - Made the halo_TS and double_diffuse arguments to set_diffusivity_init() mandatory. - Made the Time argument to ALE_sponge() mandatory. - Made the Kd and Kv arguments to calculate_CVMIX_conv() mandatory. - Removed the unused halo argument to adjust_salt(). - Removed the unused Kddt_convect argument to full_convection(). - Made the halo arguments to full_convection()and smoothed_dRdT_dRdS() mandatory. - Made the useALEalgorithm argument to geothermal_init() mandatory. - Removed the unused initialize_all arguments to Calculate_kappa_shear() and Calc_kappa_shear_vertex(). - Removed the unused I_Ld2_1d and dz_Int_1d arguments to kappa_shear_column(). - Made 3 arguments to calculate_projected_state() mandatory and reordered the arguments accordingly. - Eliminating the unused skip_diags arguments to calculateBuoyancyFlux() and extractFluxes(), which are now effectively always false. All answers are bitwise identical, and no output is changed. --- src/core/MOM_forcing_type.F90 | 43 ++-- .../vertical/MOM_ALE_sponge.F90 | 7 +- .../vertical/MOM_CVMix_KPP.F90 | 8 +- .../vertical/MOM_CVMix_conv.F90 | 28 +-- .../vertical/MOM_diabatic_aux.F90 | 8 +- .../vertical/MOM_diabatic_driver.F90 | 71 +++--- .../vertical/MOM_full_convection.F90 | 59 ++--- .../vertical/MOM_geothermal.F90 | 6 +- .../vertical/MOM_kappa_shear.F90 | 181 ++++++--------- .../vertical/MOM_set_diffusivity.F90 | 217 +++++++----------- 10 files changed, 248 insertions(+), 380 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 2429ce9d2d..a67d440dfe 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -390,7 +390,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, & h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & aggregate_FW, nonpenSW, netmassInOut_rate, net_Heat_Rate, & - net_salt_rate, pen_sw_bnd_Rate, skip_diags) + net_salt_rate, pen_sw_bnd_Rate) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -452,7 +452,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & real, dimension(max(1,nsw),G%isd:G%ied), & optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics ! local real :: htot(SZI_(G)) ! total ocean depth [H ~> m or kg m-2] @@ -492,7 +491,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & is = G%isc ; ie = G%iec ; nz = GV%ke calculate_diags = .true. - if (present(skip_diags)) calculate_diags = .not. skip_diags ! error checking @@ -914,7 +912,7 @@ end subroutine extractFluxes2d !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated !! fluxes needed in other routines that call extractFluxes. subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt, tv, j, & - buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) + buoyancyFlux, netHeatMinusSW, netSalt) type(ocean_grid_type), intent(in) :: 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 @@ -928,12 +926,11 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on 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 + real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< Surface heat flux excluding shortwave !! [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 + real, dimension(SZI_(G)), intent(inout) :: netSalt !< surface salt flux !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating - !! diagnostics inside extractFluxes1d() + ! local variables integer :: k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d @@ -942,12 +939,12 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band - ! [degC H ~> degC m or degC kg m-2] + ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R 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_(GV)+1) :: netPen ! The net penetrating shortwave radiation at each level - ! [degC H ~> degC m or degC kg m-2] + ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] logical :: useRiverHeatContent logical :: useCalvingHeatContent @@ -978,7 +975,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt*US%s_to_T, & depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & - netSalt, penSWbnd, tv, .false., skip_diags=skip_diags) + netSalt, penSWbnd, tv, .false.) ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth @@ -1011,7 +1008,7 @@ end subroutine calculateBuoyancyFlux1d !> Calculates surface buoyancy flux by adding up the heat, FW and salt fluxes, !! for 2d arrays. This is a wrapper for calculateBuoyancyFlux1d. subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, & - buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) + buoyancyFlux, netHeatMinusSW, netSalt) type(ocean_grid_type), intent(in) :: 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 @@ -1021,26 +1018,18 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, 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_(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 - !! [ppt H ~> ppt m or ppt kg m-2] - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating - !! diagnostics inside extractFluxes1d() + 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)), intent(inout) :: netHeatMinusSW !< surface heat flux excluding shortwave + !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netSalt !< Net surface salt flux + !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! local variables - real, dimension( SZI_(G) ) :: netT ! net temperature flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] - real, dimension( SZI_(G) ) :: netS ! net saln flux !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] integer :: j - netT(G%isc:G%iec) = 0. ; netS(G%isc:G%iec) = 0. - - !$OMP parallel do default(shared) firstprivate(netT,netS) + !$OMP parallel do default(shared) do j=G%jsc,G%jec call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, optics_nbands(optics), h, Temp, Salt, & - tv, j, buoyancyFlux(:,j,:), netT, netS, skip_diags=skip_diags) - if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) - if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) + tv, j, buoyancyFlux(:,j,:), netHeatMinusSW(:,j), netSalt(:,j)) enddo end subroutine calculateBuoyancyFlux2d diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 1225487eaf..4d179e2bfb 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -840,7 +840,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_ALE_sponge (in). - type(time_type), optional, intent(in) :: Time !< The current model date + type(time_type), intent(in) :: Time !< The current model date real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim]. @@ -885,8 +885,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) endif if (CS%time_varying_sponges) then - if (.not. present(Time)) & - call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, 1.0, G, sp_val, mask_z, z_in, & @@ -971,9 +969,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%sponge_uv) then if (CS%time_varying_sponges) then - if (.not. present(Time)) & - call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") - nz_data = CS%Ref_val_u%nz_data ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, 1.0, G, sp_val, mask_z, z_in, & diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 53dddcf168..b9ceb85cc5 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1389,8 +1389,8 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid 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, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of temperature + !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] real, intent(in) :: dt !< Time-step [s] 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] @@ -1451,8 +1451,8 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid 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, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt + !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, intent(in) :: dt !< Time-step [s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index a615c9f40b..138e932c22 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -150,10 +150,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) !! 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_(GV)+1), & - optional, intent(inout) :: Kd !< Diapycnal diffusivity at each interface that + 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_(GV)+1), & - optional, intent(inout) :: KV !< Viscosity at each interface that will be + 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_(GV)+1), & optional, intent(inout) :: Kd_aux !< A second diapycnal diffusivity at each @@ -243,12 +243,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) max_nlev=GV%ke, & OBL_ind=kOBL) - if (present(Kd)) then - ! Increment the diffusivity outside of the boundary layer. - do K=max(1,kOBL+1),GV%ke+1 - Kd(i,j,K) = Kd(i,j,K) + US%m2_s_to_Z2_T * kd_col(K) - enddo - endif + ! Increment the diffusivity outside of the boundary layer. + do K=max(1,kOBL+1),GV%ke+1 + Kd(i,j,K) = Kd(i,j,K) + US%m2_s_to_Z2_T * kd_col(K) + enddo if (present(Kd_aux)) then ! Increment the other diffusivity outside of the boundary layer. do K=max(1,kOBL+1),GV%ke+1 @@ -256,12 +254,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) enddo endif - if (present(Kv)) then - ! Increment the viscosity outside of the boundary layer. - do K=max(1,kOBL+1),GV%ke+1 - Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * kv_col(K) - enddo - endif + ! Increment the viscosity outside of the boundary layer. + do K=max(1,kOBL+1),GV%ke+1 + Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * kv_col(K) + enddo ! Store 3-d arrays for diagnostics. if (CS%id_kv_conv > 0) then @@ -288,8 +284,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) ! call hchksum(Kd_conv, "MOM_CVMix_conv: Kd_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) ! if (CS%id_kv_conv > 0) & ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%m2_s_to_Z2_T) - if (present(Kd)) call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - if (present(Kv)) call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif ! send diagnostics to post_data diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 8d53594ebb..4c822309d0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -318,7 +318,7 @@ end subroutine differential_diffuse_T_S !> This subroutine keeps salinity from falling below a small but positive threshold. !! This usually occurs when the ice model attempts to extract more salt then !! is actually available to it from the ocean. -subroutine adjust_salt(h, tv, G, GV, CS, halo) +subroutine adjust_salt(h, tv, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -327,7 +327,6 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) !! available thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. - integer, optional, intent(in) :: halo !< Halo width over which to work ! local variables real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement [ppt R Z ~> gSalt m-2] @@ -336,9 +335,6 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (present(halo)) then - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - endif ! call cpu_clock_begin(id_clock_adjust_salt) @@ -1024,7 +1020,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t 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)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. ! Local variables integer, parameter :: maxGroundings = 5 diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ff8c270a89..d3f92e99cc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -87,9 +87,9 @@ module MOM_diabatic_driver ! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for this module -type, public:: diabatic_CS; private +type, public :: diabatic_CS ; private - logical :: use_legacy_diabatic !< If true (default), use the a legacy version of the diabatic + logical :: use_legacy_diabatic !< If true (default), use a legacy version of the diabatic !! algorithm. This is temporary and is needed to avoid change !! in answers. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with @@ -242,11 +242,14 @@ module MOM_diabatic_driver type(group_pass_type) :: pass_Kv !< For group halo pass type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm ! Data arrays for communicating between components - real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] + !### Why are these arrays in this control structure, and not local variables in the various routines? + real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [nondim] + real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [nondim] real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] - real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] + real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux + !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux + !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type diabatic_CS @@ -274,8 +277,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -465,8 +469,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -577,11 +582,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) & call MOM_state_chksum("before set_diffusivity", u, v, h, G, GV, US, haloshift=CS%halo_TS_diff) if (CS%double_diffuse) then - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, CS%set_diff_CSp, & - Kd_int=Kd_int, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) else - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_int=Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp) endif call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -718,7 +723,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_int, Kv=visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_int, visc%Kv_slow) endif ! This block sets ent_t and ent_s from h and Kd_int. @@ -1049,8 +1054,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -1161,11 +1167,11 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) & call MOM_state_chksum("before set_diffusivity", u, v, h, G, GV, US, haloshift=CS%halo_TS_diff) if (CS%double_diffuse) then - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, CS%set_diff_CSp, & - Kd_int=Kd_heat, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_heat, G, GV, US, & + CS%set_diff_CSp, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) else - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_int=Kd_heat) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_heat, G, GV, US, & + CS%set_diff_CSp) endif call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1270,9 +1276,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection if (CS%useKPP) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_heat, Kv=visc%Kv_shear, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) else - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_heat, Kv=visc%Kv_slow, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_heat, visc%Kv_slow, Kd_aux=Kd_salt) endif endif @@ -1558,8 +1564,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -1764,11 +1771,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) & call MOM_state_chksum("before set_diffusivity", u, v, h, G, GV, US, haloshift=CS%halo_TS_diff) if (CS%double_diffuse) then - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, CS%set_diff_CSp, & - Kd_lay=Kd_lay, Kd_int=Kd_int, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp, Kd_lay=Kd_lay, Kd_extra_T=Kd_extra_T, Kd_extra_S=Kd_extra_S) else - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_lay=Kd_lay, Kd_int=Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, Kd_int, G, GV, US, & + CS%set_diff_CSp, Kd_lay=Kd_lay) endif call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1859,7 +1866,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd=Kd_int, Kv=visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_int, visc%Kv_slow) endif if (CS%useKPP) then @@ -3194,7 +3201,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') @@ -3205,8 +3212,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%useKPP) then allocate(CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1), source=0.0) allocate(CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1), source=0.0) - endif - if (CS%useKPP) then allocate(CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1), source=0.0) allocate(CS%KPP_temp_flux(isd:ied,jsd:jed), source=0.0) allocate(CS%KPP_salt_flux(isd:ied,jsd:jed), source=0.0) diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index ceb77b52b8..aa1dfbf809 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -18,8 +18,7 @@ module MOM_full_convection contains !> Calculate new temperatures and salinities that have been subject to full convective mixing. -subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & - Kddt_convect, halo) +subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, 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 @@ -34,9 +33,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, 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 !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. - real, optional, intent(in) :: Kddt_convect !< A large convecting vertical - !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. - integer, optional, intent(in) :: halo !< Halo width over which to compute + integer, intent(in) :: halo !< Halo width over which to compute ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & @@ -46,61 +43,53 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, ! in roundoff and can be neglected [H ~> m or kg m-2]. ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real, dimension(SZI_(G),SZK0_(G)) :: & - Te_a, & ! A partially updated temperature estimate including the influnce from + Te_a, & ! A partially updated temperature estimate including the influence from ! mixing with layers above rescaled by a factor of d_a [degC]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. - Se_a ! A partially updated salinity estimate including the influnce from + Se_a ! A partially updated salinity estimate including the influence from ! mixing with layers above rescaled by a factor of d_a [ppt]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. real, dimension(SZI_(G),SZK_(GV)+1) :: & - Te_b, & ! A partially updated temperature estimate including the influnce from + Te_b, & ! A partially updated temperature estimate including the influence from ! mixing with layers below rescaled by a factor of d_b [degC]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. - Se_b ! A partially updated salinity estimate including the influnce from + Se_b ! A partially updated salinity estimate including the influence from ! mixing with layers below rescaled by a factor of d_b [ppt]. - ! This array is discreted on tracer cells, but contains an extra + ! This array is discretized on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. 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. + ! in the final properties with a downward-first solver [nondim] d_a, & ! The fractional influence of the properties of the layer in question - ! and layers above in the final properies with a downward-first solver, nondim. + ! and layers above in the final properties with a downward-first solver [nondim] ! d_a = 1.0 - c_a c_b, & ! The fractional influence of the properties of the layer above - ! in the final properies with a upward-first solver, nondim. + ! in the final properties with a upward-first solver [nondim] 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. + ! and layers below in the final properties with a upward-first solver [nondim] ! d_b = 1.0 - c_b 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] + real :: h_b, h_a ! The thicknesses of the layers above and below an interface [H ~> m or kg m-2] real :: b_b, b_a ! Inverse pivots used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. - logical, dimension(SZI_(G)) :: do_i ! Do more work on this column. logical, dimension(SZI_(G)) :: last_down ! The last setup pass was downward. integer, dimension(SZI_(G)) :: change_ct ! The number of interfaces where the ! mixing has changed this iteration. - integer :: changed_col ! The number of colums whose mixing changed. + integer :: changed_col ! The number of columns whose mixing changed. integer :: i, j, k, is, ie, js, je, nz, itt - if (present(halo)) then - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - else - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - endif + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = GV%ke if (.not.associated(tv%eqn_of_state)) return h_neglect = GV%H_subroundoff - kap_dt_x2 = 0.0 - if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H) h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect @@ -135,7 +124,6 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, Te_a(i,k-2), Te_b(i,k+1), Se_a(i,k-2), Se_b(i,k+1), & d_a(i,K-1), d_b(i,K+1))) then mix(i,K) = mix_len - if (kap_dt_x2 > 0.0) mix(i,K) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0) change_ct(i) = change_ct(i) + 1 endif endif @@ -178,7 +166,6 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, Te_a(i,k-2), Te_b(i,k+1), Se_a(i,k-2), Se_b(i,k+1), & d_a(i,K-1), d_b(i,K+1))) then mix(i,K) = mix_len - if (kap_dt_x2 > 0.0) mix(i,K) = kap_dt_x2 / ((h(i,j,k-1)+h(i,j,k)) + h0) change_ct(i) = change_ct(i) + 1 endif endif @@ -260,7 +247,7 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, k = 1 ! A hook for debugging. - ! The following set of expressions for the final values are derived from the the partial + ! The following set of expressions for the final values are derived from the partial ! updates for the estimated temperatures and salinities around an interface, then directly ! solving for the final temperatures and salinities. They are here for later reference ! and to document an intermediate step in the stability calculation. @@ -336,7 +323,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-point to work on. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa]. - integer, optional, intent(in) :: halo !< Halo width over which to compute + integer, intent(in) :: halo !< Halo width over which to compute ! Local variables real :: mix(SZI_(G),SZK_(GV)+1) ! The diffusive mixing length (kappa*dt)/dz @@ -352,14 +339,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses, ! [H ~> m or kg m-2]. real :: h_tr ! The thickness at tracer points, plus h_neglect [H ~> m or kg m-2]. - integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz - if (present(halo)) then - is = G%isc-halo ; ie = G%iec+halo - else - is = G%isc ; ie = G%iec - endif + is = G%isc-halo ; ie = G%iec+halo nz = GV%ke h_neglect = GV%H_subroundoff diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 7944d4b89f..90da24f170 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -499,7 +499,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. type(geothermal_CS), pointer :: CS !< Pointer pointing to the module control !! structure. - logical, optional, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping + logical, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping ! This include declares and sets the variable "version". #include "version_variable.h" @@ -587,13 +587,13 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & 'degC s-1', conversion=US%s_to_T, v_extensive=.true.) - if (present(useALEalgorithm)) then ; if (.not.useALEalgorithm) then + if (.not.useALEalgorithm) then ! Do not offer this diagnostic if heating will be in place. CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & trim(thickness_units)//' s-1', conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.) - endif ; endif + endif end subroutine geothermal_init diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 033f717091..a44a7aee95 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -107,7 +107,7 @@ module MOM_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in tracer columns subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, US, CS, initialize_all) + kv_io, 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 @@ -137,8 +137,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. - logical, optional, intent(in) :: initialize_all !< If present and false, the previous - !! value of kappa is used to start the iterations ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & @@ -168,8 +166,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real :: dz_massless ! A layer thickness that is considered massless [Z ~> m]. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. - logical :: new_kappa = .true. ! If true, ignore the value of kappa from the - ! last call to this subroutine. integer, dimension(SZK_(GV)+1) :: kc ! The index map between the original ! interfaces and the interfaces with massless layers @@ -180,14 +176,13 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & is = G%isc ; ie = G%iec; js = G%jsc ; je = G%jec ; nz = GV%ke - use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. - new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all + use_temperature = associated(tv%T) k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) - !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,new_kappa, & - !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) + !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,tv,G,GV,US, & + !$OMP CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do j=js,je do k=1,nz ; do i=is,ie h_2d(i,k) = h(i,j,k)*GV%H_to_Z @@ -198,9 +193,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo ; enddo ; else ; do k=1,nz ; do i=is,ie rho_2d(i,k) = GV%Rlay(k) ! Could be tv%Rho(i,j,k) ? enddo ; enddo ; endif - if (.not.new_kappa) then ; do K=1,nz+1 ; do i=is,ie - kappa_2d(i,K) = kappa_io(i,j,K) - enddo ; enddo ; endif !--------------------------------------- ! Work on each column. @@ -278,11 +270,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo - else - do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo - endif + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -340,7 +328,7 @@ end subroutine Calculate_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in corner columns subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, US, CS, initialize_all) + kv_io, 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 @@ -373,8 +361,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. - logical, optional, intent(in) :: initialize_all !< If present and false, the previous - !! value of kappa is used to start the iterations ! Local variables real, dimension(SZIB_(G),SZK_(GV)) :: & @@ -397,7 +383,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. + real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [R L2 T-2 ~> Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -407,8 +393,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real :: I_Prandtl ! The inverse of the turbulent Prandtl number [nondim]. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. - logical :: new_kappa = .true. ! If true, ignore the value of kappa from the - ! last call to this subroutine. logical :: do_i ! If true, work on this column. integer, dimension(SZK_(GV)+1) :: kc ! The index map between the original @@ -421,15 +405,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Diagnostics that should be deleted? isB = G%isc-1 ; ieB = G%iecB ; jsB = G%jsc-1 ; jeB = G%jecB ; nz = GV%ke - use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. - new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all + use_temperature = associated(tv%T) k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb - !$OMP parallel do default(private) shared(jsB,jeB,isB,ieB,nz,h,u_in,v_in,use_temperature,new_kappa, & - !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io,I_Prandtl) + !$OMP parallel do default(private) shared(jsB,jeB,isB,ieB,nz,h,u_in,v_in,use_temperature,tv,G,GV, & + !$OMP US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io,I_Prandtl) do J=JsB,JeB J2 = mod(J,2)+1 ; J2m1 = 3-J2 ! = mod(J-1,2)+1 @@ -467,9 +450,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif - if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl - enddo ; enddo ; endif !--------------------------------------- ! Work on each column. @@ -558,11 +538,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo - else - do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo - endif + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -621,9 +597,8 @@ end subroutine Calc_kappa_shear_vertex !> This subroutine calculates shear-driven diffusivity and TKE in a single column -subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & - dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & + u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, tke_avg, tv, CS, GV, US) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZK_(GV)+1), & intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. @@ -654,11 +629,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZK_(GV)+1), & - optional, intent(out) :: I_Ld2_1d !< The inverse of the squared mixing length [Z-2 ~> m-2]. - real, dimension(SZK_(GV)+1), & - optional, intent(out) :: dz_Int_1d !< The extent of a finite-volume space surrounding an interface, - !! as used in calculating kappa and TKE [Z ~> m]. ! Local variables real, dimension(nzc) :: & @@ -858,9 +828,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! enddo ! This call just calculates N2 and S2. - call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u, v, T, Sal, GV, US, & - N2=N2, S2=S2, vel_underflow=CS%vel_underflow) + call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, & + CS%vel_underflow, u, v, T, Sal, N2, S2, GV, US) ! ---------------------------------------------------- ! Iterate ! ---------------------------------------------------- @@ -923,9 +892,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! value of max_KS_it may be unimportant, especially if it is large ! enough. call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, & - vel_underflow=CS%vel_underflow) + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, & + T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) valid_dt = .true. Idtt = 1.0 / dt_test do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) @@ -956,9 +924,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if ((dt_test < dt_rem) .and. valid_dt) then dt_inc = 0.5*dt_test do itt_dt=1,dt_refinements - call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), & - nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, vel_underflow=CS%vel_underflow) + call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), nzc, dz, & + I_dz_int, dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, T_test, S_test, & + N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) valid_dt = .true. Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) @@ -1006,9 +974,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & else ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & - vel_underflow=CS%vel_underflow) + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, & + T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) @@ -1026,9 +993,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, US, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & - vel_underflow=CS%vel_underflow) + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, & + T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) @@ -1050,9 +1016,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (dt_rem > 0.0) then ! Update the values of u, v, T, Sal, N2, and S2 for the next iteration. ! call cpu_clock_begin(id_clock_project) - call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, u, v, T, Sal, & - GV, US, N2, S2, vel_underflow=CS%vel_underflow) + call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & + dbuoy_dT, dbuoy_dS, CS%vel_underflow, u, v, T, Sal, N2, S2, & + GV, US) ! call cpu_clock_end(id_clock_project) endif @@ -1060,25 +1026,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo ! end itt loop - if (present(I_Ld2_1d)) then - do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo - do K=2,nzc ; if (TKE(K) > 0.0) & - I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) / TKE(K) - enddo - endif - if (present(dz_Int_1d)) then - do K=1,nzc+1 ; dz_Int_1d(K) = dz_Int(K) ; enddo - do K=nzc+2,GV%ke ; dz_Int_1d(K) = 0.0 ; enddo - endif - end subroutine kappa_shear_column !> This subroutine calculates the velocities, temperature and salinity that !! the water column will have after mixing for dt with diffusivities kappa. It !! may also calculate the projected buoyancy frequency and shear. -subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, GV, US, N2, S2, ks_int, ke_int, vel_underflow) +subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int, dbuoy_dT, dbuoy_dS, & + vel_under, u, v, T, Sal, N2, S2, GV, US, ks_int, ke_int) integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, @@ -1087,6 +1041,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [L T-1 ~> m s-1]. real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. real, dimension(nz), intent(in) :: S0 !< The initial salinity [ppt]. + real, intent(in) :: dt !< The time step [T ~> s]. real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. @@ -1094,36 +1049,30 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & !! temperature [Z T-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with !! salinity [Z T-2 ppt-1 ~> m s-2 ppt-1]. - real, intent(in) :: dt !< The time step [T ~> s]. + real, intent(in) :: vel_under !< Any velocities that are smaller in magnitude + !! than this value are set to 0 [L T-1 ~> m s-1]. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [L T-1 ~> m s-1]. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [L T-1 ~> m s-1]. real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [ppt]. + real, dimension(nz+1), intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. + real, dimension(nz+1), intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. 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(nz+1), optional, & - intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. - real, dimension(nz+1), optional, & - intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero !! diffusivity. - real, optional, intent(in) :: vel_underflow !< If present and true, any velocities that - !! are smaller in magnitude than this value are - !! set to 0 [L T-1 ~> m s-1]. ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth ! units squared [Z2 s2 T-2 m-2 ~> 1]. - real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0 [L T-1 ~> m s-1]. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke ks = 1 ; ke = nz if (present(ks_int)) ks = max(ks_int-1,1) if (present(ke_int)) ke = min(ke_int,nz) - underflow_vel = 0.0 ; if (present(vel_underflow)) underflow_vel = vel_underflow if (ks > ke) return @@ -1166,51 +1115,49 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif u(ke) = b1nz_0 * (dz(ke)*u0(ke) + a_a*u(ke-1)) v(ke) = b1nz_0 * (dz(ke)*v0(ke) + a_a*v(ke-1)) - if (abs(u(ke)) < underflow_vel) u(ke) = 0.0 - if (abs(v(ke)) < underflow_vel) v(ke) = 0.0 + if (abs(u(ke)) < vel_under) u(ke) = 0.0 + if (abs(v(ke)) < vel_under) v(ke) = 0.0 do k=ke-1,ks,-1 u(k) = u(k) + c1(k+1)*u(k+1) v(k) = v(k) + c1(k+1)*v(k+1) - if (abs(u(k)) < underflow_vel) u(k) = 0.0 - if (abs(v(k)) < underflow_vel) v(k) = 0.0 + if (abs(u(k)) < vel_under) u(k) = 0.0 + if (abs(v(k)) < vel_under) v(k) = 0.0 T(k) = T(k) + c1(k+1)*T(k+1) Sal(k) = Sal(k) + c1(k+1)*Sal(k+1) enddo else ! dt <= 0.0 do k=1,nz u(k) = u0(k) ; v(k) = v0(k) ; T(k) = T0(k) ; Sal(k) = S0(k) - if (abs(u(k)) < underflow_vel) u(k) = 0.0 - if (abs(v(k)) < underflow_vel) v(k) = 0.0 + if (abs(u(k)) < vel_under) u(k) = 0.0 + if (abs(v(k)) < vel_under) v(k) = 0.0 enddo endif - if (present(S2)) then - ! L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 - L2_to_Z2 = US%L_to_Z**2 - S2(1) = 0.0 ; S2(nz+1) = 0.0 - if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) - do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (L2_to_Z2*I_dz_int(K)**2) - enddo - if (ke 1) & - N2(ks) = max(0.0, I_dz_int(ks) * & - (dbuoy_dT(ks) * (T0(ks-1)-T(ks)) + dbuoy_dS(ks) * (S0(ks-1)-Sal(ks)))) - do K=ks+1,ke - N2(K) = max(0.0, I_dz_int(K) * & - (dbuoy_dT(K) * (T(k-1)-T(k)) + dbuoy_dS(K) * (Sal(k-1)-Sal(k)))) - enddo - if (ke 1) & + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) + do K=ks+1,ke + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (L2_to_Z2*I_dz_int(K)**2) + enddo + if (ke 1) & + N2(ks) = max(0.0, I_dz_int(ks) * & + (dbuoy_dT(ks) * (T0(ks-1)-T(ks)) + dbuoy_dS(ks) * (S0(ks-1)-Sal(ks)))) + do K=ks+1,ke + N2(K) = max(0.0, I_dz_int(K) * & + (dbuoy_dT(K) * (T(k-1)-T(k)) + dbuoy_dS(K) * (Sal(k-1)-Sal(k)))) + enddo + if (ke s]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 T-1 ~> m2 s-1]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. 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_(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_(GV)+1), & optional, intent(out) :: Kd_extra_T !< The extra diffusivity at interfaces of !! temperature due to double diffusion relative to @@ -302,7 +302,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set Kd_lay, Kd_int and Kv_slow to constant values, mostly to fill the halos. if (present(Kd_lay)) Kd_lay(:,:,:) = CS%Kd - if (present(Kd_int)) Kd_int(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd if (present(Kd_extra_T)) Kd_extra_T(:,:,:) = 0.0 if (present(Kd_extra_S)) Kd_extra_S(:,:,:) = 0.0 if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv @@ -468,98 +468,69 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the input turbulent diffusivity. if (CS%useKappaShear .or. CS%use_CVMix_shear) then - if (present(Kd_int)) then - do K=2,nz ; do i=is,ie - Kd_int_2d(i,K) = visc%Kd_shear(i,j,K) + 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) - enddo ; enddo - do i=is,ie - Kd_int_2d(i,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. - Kd_int_2d(i,nz+1) = 0.0 - enddo - endif + do K=2,nz ; do i=is,ie + Kd_int_2d(i,K) = visc%Kd_shear(i,j,K) + 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) + enddo ; enddo + do i=is,ie + Kd_int_2d(i,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int_2d(i,nz+1) = 0.0 + enddo do k=1,nz ; do i=is,ie Kd_lay_2d(i,k) = Kd_lay_2d(i,k) + 0.5 * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else - if (present(Kd_int)) then - do i=is,ie - Kd_int_2d(i,1) = Kd_lay_2d(i,1) ; Kd_int_2d(i,nz+1) = 0.0 - enddo - do K=2,nz ; do i=is,ie - Kd_int_2d(i,K) = 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) - enddo ; enddo - endif + do i=is,ie + Kd_int_2d(i,1) = Kd_lay_2d(i,1) ; Kd_int_2d(i,nz+1) = 0.0 + enddo + do K=2,nz ; do i=is,ie + Kd_int_2d(i,K) = 0.5 * (Kd_lay_2d(i,k-1) + Kd_lay_2d(i,k)) + enddo ; enddo endif - if (present(Kd_int)) then - ! Add the ML_Rad diffusivity. - if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d, Kd_int_2d) - - ! Add the Nikurashin and / or tidal bottom-driven mixing - if (CS%use_tidal_mixing) & - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tidal_mixing_CSp, & - N2_lay, N2_int, Kd_lay_2d, Kd_int_2d, CS%Kd_max, visc%Kv_slow) - - ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. - if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then - if (CS%use_LOTW_BBL_diffusivity) then - call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & - dd%Kd_BBL, Kd_lay_2d, Kd_int_2d) - else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, US, CS, Kd_lay_2d, Kd_int_2d, dd%Kd_BBL) - endif - endif + ! Add the ML_Rad diffusivity. + if (CS%ML_radiation) & + call add_MLrad_diffusivity(h, fluxes, j, Kd_int_2d, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d) - if (CS%limit_dissipation) then - ! This calculates the dissipation ONLY from Kd calculated in this routine - ! dissip has units of W/m3 (= kg/m3 * m2/s * 1/s2) - ! 1) a global constant, - ! 2) a dissipation proportional to N (aka Gargett) and - ! 3) dissipation corresponding to a (nearly) constant diffusivity. - do K=2,nz ; do i=is,ie - dissip = max( CS%dissip_min, & ! Const. floor on dissip. - CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett - CS%dissip_N2 * N2_int(i,K)) ! Floor of Kd_min*rho0/F_Ri - Kd_int_2d(i,K) = max(Kd_int_2d(i,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) - enddo ; enddo - endif + ! Add the Nikurashin and / or tidal bottom-driven mixing + if (CS%use_tidal_mixing) & + call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tidal_mixing_CSp, & + N2_lay, N2_int, Kd_lay_2d, Kd_int_2d, CS%Kd_max, visc%Kv_slow) - ! Optionally add a uniform diffusivity at the interfaces. - if (CS%Kd_add > 0.0) then ; do K=1,nz+1 ; do i=is,ie - Kd_int_2d(i,K) = Kd_int_2d(i,K) + CS%Kd_add - enddo ; enddo ; endif + ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. + if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then + if (CS%use_LOTW_BBL_diffusivity) then + call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int_2d, G, GV, US, CS, & + dd%Kd_BBL, Kd_lay_2d) + else + call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & + maxTKE, kb, G, GV, US, CS, Kd_lay_2d, Kd_int_2d, dd%Kd_BBL) + endif + endif - ! Copy the 2-d slices into the 3-d array that is exported. - do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd_int_2d(i,K) + if (CS%limit_dissipation) then + ! This calculates the dissipation ONLY from Kd calculated in this routine + ! dissip has units of W/m3 (= kg/m3 * m2/s * 1/s2) + ! 1) a global constant, + ! 2) a dissipation proportional to N (aka Gargett) and + ! 3) dissipation corresponding to a (nearly) constant diffusivity. + do K=2,nz ; do i=is,ie + dissip = max( CS%dissip_min, & ! Const. floor on dissip. + CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett + CS%dissip_N2 * N2_int(i,K)) ! Floor of Kd_min*rho0/F_Ri + Kd_int_2d(i,K) = max(Kd_int_2d(i,K) , & ! Apply floor to Kd + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) enddo ; enddo + endif - else ! Kd_int is not present. - - ! Add the ML_Rad diffusivity. - if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d) - - ! Add the Nikurashin and / or tidal bottom-driven mixing - if (CS%use_tidal_mixing) & - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tidal_mixing_CSp, & - N2_lay, N2_int, Kd_lay_2d, Kd_max=CS%Kd_max, Kv=visc%Kv_slow) - - ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. - if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then - if (CS%use_LOTW_BBL_diffusivity) then - call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & - dd%Kd_BBL, Kd_lay_2d) - else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, US, CS, Kd_lay_2d, Kd_BBL=dd%Kd_BBL) - endif - endif + ! Optionally add a uniform diffusivity at the interfaces. + if (CS%Kd_add > 0.0) then ; do K=1,nz+1 ; do i=is,ie + Kd_int_2d(i,K) = Kd_int_2d(i,K) + CS%Kd_add + enddo ; enddo ; endif - endif + ! Copy the 2-d slices into the 3-d array that is exported. + do K=1,nz+1 ; do i=is,ie + Kd_int(i,j,K) = Kd_int_2d(i,K) + enddo ; enddo if (CS%limit_dissipation) then ! This calculates the layer dissipation ONLY from Kd calculated in this routine @@ -1163,7 +1134,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! thermodynamic fields. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom - !! boundary layer properies, and related fields + !! boundary layer properties and related fields integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1177,8 +1148,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure 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_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, + real, dimension(SZI_(G),SZK_(GV)+1), 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]. @@ -1330,10 +1300,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else Kd_lay(i,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) endif - if (present(Kd_int)) then - Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd - Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd - endif + Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd + Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * delta_Kd @@ -1357,10 +1325,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & delta_Kd = TKE_here * TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,k) = Kd_lay(i,k) + delta_Kd - if (present(Kd_int)) then - Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd - Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd - endif + Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd + Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * delta_Kd @@ -1386,8 +1352,8 @@ end subroutine add_drag_diffusivity !> Calculates a BBL diffusivity use a Prandtl number 1 diffusivity with a law of the !! wall turbulent viscosity, up to a BBL height where the energy used for mixing has !! consumed the mechanical TKE input. -subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & - G, GV, US, CS, Kd_BBL, Kd_lay, Kd_int) +subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int, & + G, GV, US, CS, Kd_BBL, Kd_lay) 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 @@ -1401,16 +1367,16 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & !! thermodynamic fields. type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom - !! boundary layer properies, and related fields. + !! boundary layer properties and related fields. integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(GV)+1), & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [T-2 ~> s-2] + real, dimension(SZI_(G),SZK_(GV)+1), & + intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] 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_(GV)), & optional, intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] ! Local variables real :: TKE_column ! net TKE input into the column [Z3 T-3 ~> m3 s-3] @@ -1537,7 +1503,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative ! Add this BBL diffusivity to the model net diffusivity. - if (present(Kd_int)) Kd_int(i,K) = Kd_int(i,K) + Kd_wall + Kd_int(i,K) = Kd_int(i,K) + Kd_wall if (present(Kd_lay)) Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * (Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next layer up. if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall @@ -1547,7 +1513,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & end subroutine add_LOTW_BBL_diffusivity !> This routine adds effects of mixed layer radiation to the layer diffusivities. -subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, Kd_int) +subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, 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 @@ -1555,6 +1521,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, 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 + real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces + !! [Z2 T-1 ~> m2 s-1]. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1563,9 +1531,6 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces - !! [Z2 T-1 ~> m2 s-1]. ! This routine adds effects of mixed layer radiation to the layer diffusivities. @@ -1639,14 +1604,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, Kd_lay(i,k) = Kd_lay(i,k) + Kd_mlr_ml(i) endif ; enddo ; enddo endif - if (present(Kd_int)) then - do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,K) = Kd_int(i,K) + Kd_mlr_ml(i) - endif ; enddo ; enddo - if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,Kml+2) = Kd_int(i,Kml+2) + 0.5 * Kd_mlr_ml(i) - endif ; enddo ; endif - endif + do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then + Kd_int(i,K) = Kd_int(i,K) + Kd_mlr_ml(i) + endif ; enddo ; enddo + if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then + Kd_int(i,Kml+2) = Kd_int(i,Kml+2) + 0.5 * Kd_mlr_ml(i) + endif ; enddo ; endif do k=kml+2,nz-1 do_any = .false. @@ -1674,10 +1637,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, TKE_to_Kd, Kd_lay, if (present(Kd_lay)) then Kd_lay(i,k) = Kd_lay(i,k) + Kd_mlr endif - if (present(Kd_int)) then - Kd_int(i,K) = Kd_int(i,K) + 0.5 * Kd_mlr - Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * Kd_mlr - endif + Kd_int(i,K) = Kd_int(i,K) + 0.5 * Kd_mlr + Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * Kd_mlr TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) if (TKE_ml_flux(i) * I_decay(i) < 0.1 * CS%Kd_min * Omega2) then @@ -1703,7 +1664,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) 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 - !! boundary layer properies, and related fields. + !! boundary layer properties and related fields. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. @@ -1995,10 +1956,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ !! structure. type(int_tide_CS), pointer :: int_tide_CSp !< A pointer to the internal tides control !! structure - integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be + integer, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. - logical, optional, intent(out) :: double_diffuse !< If present, this indicates whether - !! some version of double diffusion is being used. + logical, intent(out) :: double_diffuse !< This indicates whether some version + !! of double diffusion is being used. ! Local variables real :: decay_length @@ -2323,14 +2284,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ 'Double-diffusion density ratio', 'nondim') endif - if (present(halo_TS)) then - halo_TS = 0 - if (CS%Vertex_Shear) halo_TS = 1 - endif + halo_TS = 0 + if (CS%Vertex_Shear) halo_TS = 1 - if (present(double_diffuse)) then - double_diffuse = (CS%double_diffusion .or. CS%use_CVMix_ddiff) - endif + double_diffuse = (CS%double_diffusion .or. CS%use_CVMix_ddiff) end subroutine set_diffusivity_init From 2e7624b4455c16a681882c52e0e197ed0e63bc60 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Oct 2021 07:31:00 -0400 Subject: [PATCH 025/138] +Move rotate_dyn_horgrid to MOM_dyn_horgrid module Moved the routine rotate_dyngrid() from the MOM_transcribe_grid module to rotate_dyn_horgrid() in the MOM_dyn_horgrid module so that this routine can also be used at some point by SIS2 to implement rotational consistency testing, and also to reflect that this routine only works with types from its new module. The two routines are the same apart from some added comments, and the old name of rotate_dyngrid() is still available from MOM_transcribe_grid via a module use statement. All answers are bitwise identical. --- src/core/MOM_transcribe_grid.F90 | 104 +++--------------------------- src/framework/MOM_dyn_horgrid.F90 | 98 ++++++++++++++++++++++++++-- 2 files changed, 101 insertions(+), 101 deletions(-) diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index f176d6671c..d3447f6590 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -4,14 +4,14 @@ module MOM_transcribe_grid ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_array_transform, only: rotate_array, rotate_array_pair -use MOM_domains, only : pass_var, pass_vector -use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE, AGRID, BGRID_NE, CORNER -use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_grid, only : ocean_grid_type, set_derived_metrics -use MOM_unit_scaling, only : unit_scale_type - +use MOM_array_transform, only : rotate_array, rotate_array_pair +use MOM_domains, only : pass_var, pass_vector +use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE, AGRID, BGRID_NE, CORNER +use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid +use MOM_dyn_horgrid, only : rotate_dyngrid=>rotate_dyn_horgrid +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_grid, only : ocean_grid_type, set_derived_metrics +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -309,92 +309,4 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) end subroutine copy_MOM_grid_to_dyngrid -subroutine rotate_dyngrid(G_in, G, US, turns) - type(dyn_horgrid_type), intent(in) :: G_in !< Common horizontal grid type - type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid type - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, intent(in) :: turns !< Number of quarter turns - - integer :: jsc, jec, jscB, jecB - integer :: qturn - - ! Center point - call rotate_array(G_in%geoLonT, turns, G%geoLonT) - call rotate_array(G_in%geoLatT, turns, G%geoLatT) - call rotate_array_pair(G_in%dxT, G_in%dyT, turns, G%dxT, G%dyT) - call rotate_array(G_in%areaT, turns, G%areaT) - call rotate_array(G_in%bathyT, turns, G%bathyT) - - call rotate_array_pair(G_in%df_dx, G_in%df_dy, turns, G%df_dx, G%df_dy) - call rotate_array(G_in%sin_rot, turns, G%sin_rot) - call rotate_array(G_in%cos_rot, turns, G%cos_rot) - call rotate_array(G_in%mask2dT, turns, G%mask2dT) - - ! Face point - call rotate_array_pair(G_in%geoLonCu, G_in%geoLonCv, turns, & - G%geoLonCu, G%geoLonCv) - call rotate_array_pair(G_in%geoLatCu, G_in%geoLatCv, turns, & - G%geoLatCu, G%geoLatCv) - call rotate_array_pair(G_in%dxCu, G_in%dyCv, turns, G%dxCu, G%dyCv) - call rotate_array_pair(G_in%dxCv, G_in%dyCu, turns, G%dxCv, G%dyCu) - call rotate_array_pair(G_in%dx_Cv, G_in%dy_Cu, turns, G%dx_Cv, G%dy_Cu) - - call rotate_array_pair(G_in%mask2dCu, G_in%mask2dCv, turns, & - G%mask2dCu, G%mask2dCv) - call rotate_array_pair(G_in%areaCu, G_in%areaCv, turns, & - G%areaCu, G%areaCv) - call rotate_array_pair(G_in%IareaCu, G_in%IareaCv, turns, & - G%IareaCu, G%IareaCv) - - ! Vertex point - call rotate_array(G_in%geoLonBu, turns, G%geoLonBu) - call rotate_array(G_in%geoLatBu, turns, G%geoLatBu) - call rotate_array_pair(G_in%dxBu, G_in%dyBu, turns, G%dxBu, G%dyBu) - call rotate_array(G_in%areaBu, turns, G%areaBu) - call rotate_array(G_in%CoriolisBu, turns, G%CoriolisBu) - call rotate_array(G_in%mask2dBu, turns, G%mask2dBu) - - ! Topographic - G%bathymetry_at_vel = G_in%bathymetry_at_vel - if (G%bathymetry_at_vel) then - call rotate_array_pair(G_in%Dblock_u, G_in%Dblock_v, turns, & - G%Dblock_u, G%Dblock_v) - call rotate_array_pair(G_in%Dopen_u, G_in%Dopen_v, turns, & - G%Dopen_u, G%Dopen_v) - endif - - ! Nominal grid axes - ! TODO: We should not assign lat values to the lon axis, and vice versa. - ! We temporarily copy lat <-> lon since several components still expect - ! lat and lon sizes to match the first and second dimension sizes. - ! But we ought to instead leave them unchanged and adjust the references to - ! these axes. - if (modulo(turns, 2) /= 0) then - G%gridLonT(:) = G_in%gridLatT(G_in%jeg:G_in%jsg:-1) - G%gridLatT(:) = G_in%gridLonT(:) - G%gridLonB(:) = G_in%gridLatB(G_in%jeg:(G_in%jsg-1):-1) - G%gridLatB(:) = G_in%gridLonB(:) - else - G%gridLonT(:) = G_in%gridLonT(:) - G%gridLatT(:) = G_in%gridLatT(:) - G%gridLonB(:) = G_in%gridLonB(:) - G%gridLatB(:) = G_in%gridLatB(:) - endif - - G%x_axis_units = G_in%y_axis_units - G%y_axis_units = G_in%x_axis_units - G%south_lat = G_in%south_lat - G%west_lon = G_in%west_lon - G%len_lat = G_in%len_lat - G%len_lon = G_in%len_lon - - ! Rotation-invariant fields - G%areaT_global = G_in%areaT_global - G%IareaT_global = G_in%IareaT_global - G%Rad_Earth = G_in%Rad_Earth - G%max_depth = G_in%max_depth - - call set_derived_dyn_horgrid(G, US) -end subroutine rotate_dyngrid - end module MOM_transcribe_grid diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 43aeb3372a..c7db67ee17 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -4,15 +4,16 @@ module MOM_dyn_horgrid ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_hor_index, only : hor_index_type -use MOM_domains, only : MOM_domain_type, deallocate_MOM_domain -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_unit_scaling, only : unit_scale_type +use MOM_array_transform, only : rotate_array, rotate_array_pair +use MOM_domains, only : MOM_domain_type, deallocate_MOM_domain +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_hor_index, only : hor_index_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid -public rescale_dyn_horgrid_bathymetry +public rescale_dyn_horgrid_bathymetry, rotate_dyn_horgrid ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -279,6 +280,93 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) end subroutine create_dyn_horgrid + +!> Copy the rotated contents of one horizontal grid type into another. The input +!! and output grid type arguments can not use the same object. +subroutine rotate_dyn_horgrid(G_in, G, US, turns) + type(dyn_horgrid_type), intent(in) :: G_in !< The input horizontal grid type + type(dyn_horgrid_type), intent(inout) :: G !< An output rotated horizontal grid type + !! that has already been allocated, but whose + !! contents are largely replaced here. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: turns !< Number of quarter turns + + integer :: jsc, jec, jscB, jecB + integer :: qturn + + ! Center point + call rotate_array(G_in%geoLonT, turns, G%geoLonT) + call rotate_array(G_in%geoLatT, turns, G%geoLatT) + call rotate_array_pair(G_in%dxT, G_in%dyT, turns, G%dxT, G%dyT) + call rotate_array(G_in%areaT, turns, G%areaT) + call rotate_array(G_in%bathyT, turns, G%bathyT) + + call rotate_array_pair(G_in%df_dx, G_in%df_dy, turns, G%df_dx, G%df_dy) + call rotate_array(G_in%sin_rot, turns, G%sin_rot) + call rotate_array(G_in%cos_rot, turns, G%cos_rot) + call rotate_array(G_in%mask2dT, turns, G%mask2dT) + + ! Face points + call rotate_array_pair(G_in%geoLonCu, G_in%geoLonCv, turns, G%geoLonCu, G%geoLonCv) + call rotate_array_pair(G_in%geoLatCu, G_in%geoLatCv, turns, G%geoLatCu, G%geoLatCv) + call rotate_array_pair(G_in%dxCu, G_in%dyCv, turns, G%dxCu, G%dyCv) + call rotate_array_pair(G_in%dxCv, G_in%dyCu, turns, G%dxCv, G%dyCu) + call rotate_array_pair(G_in%dx_Cv, G_in%dy_Cu, turns, G%dx_Cv, G%dy_Cu) + + call rotate_array_pair(G_in%mask2dCu, G_in%mask2dCv, turns, G%mask2dCu, G%mask2dCv) + call rotate_array_pair(G_in%areaCu, G_in%areaCv, turns, G%areaCu, G%areaCv) + call rotate_array_pair(G_in%IareaCu, G_in%IareaCv, turns, G%IareaCu, G%IareaCv) + + ! Vertex point + call rotate_array(G_in%geoLonBu, turns, G%geoLonBu) + call rotate_array(G_in%geoLatBu, turns, G%geoLatBu) + call rotate_array_pair(G_in%dxBu, G_in%dyBu, turns, G%dxBu, G%dyBu) + call rotate_array(G_in%areaBu, turns, G%areaBu) + call rotate_array(G_in%CoriolisBu, turns, G%CoriolisBu) + call rotate_array(G_in%mask2dBu, turns, G%mask2dBu) + + ! Topography at the cell faces + G%bathymetry_at_vel = G_in%bathymetry_at_vel + if (G%bathymetry_at_vel) then + call rotate_array_pair(G_in%Dblock_u, G_in%Dblock_v, turns, G%Dblock_u, G%Dblock_v) + call rotate_array_pair(G_in%Dopen_u, G_in%Dopen_v, turns, G%Dopen_u, G%Dopen_v) + endif + + ! Nominal grid axes + ! TODO: We should not assign lat values to the lon axis, and vice versa. + ! We temporarily copy lat <-> lon since several components still expect + ! lat and lon sizes to match the first and second dimension sizes. + ! But we ought to instead leave them unchanged and adjust the references to + ! these axes. + if (modulo(turns, 2) /= 0) then + G%gridLonT(:) = G_in%gridLatT(G_in%jeg:G_in%jsg:-1) + G%gridLatT(:) = G_in%gridLonT(:) + G%gridLonB(:) = G_in%gridLatB(G_in%jeg:(G_in%jsg-1):-1) + G%gridLatB(:) = G_in%gridLonB(:) + else + G%gridLonT(:) = G_in%gridLonT(:) + G%gridLatT(:) = G_in%gridLatT(:) + G%gridLonB(:) = G_in%gridLonB(:) + G%gridLatB(:) = G_in%gridLatB(:) + endif + + G%x_axis_units = G_in%y_axis_units + G%y_axis_units = G_in%x_axis_units + G%south_lat = G_in%south_lat + G%west_lon = G_in%west_lon + G%len_lat = G_in%len_lat + G%len_lon = G_in%len_lon + + ! Rotation-invariant fields + G%areaT_global = G_in%areaT_global + G%IareaT_global = G_in%IareaT_global + G%Rad_Earth = G_in%Rad_Earth + G%max_depth = G_in%max_depth + + call set_derived_dyn_horgrid(G, US) +end subroutine rotate_dyn_horgrid + + !> rescale_dyn_horgrid_bathymetry permits a change in the internal units for the bathymetry on the !! grid, both rescaling the depths and recording the new internal depth units. subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) From 5a2bb8db6de914335b34b94dae6d7ec0a176a978 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Oct 2021 07:31:19 -0400 Subject: [PATCH 026/138] +Reduce use of dyn_horgrid in initialize_MOM Minimized the dependence on dyn_horgrid in initialize_MOM by working directly with the horizontal index type whereever possible and by moving the calls that create the MOM_grid_type earlier in the routine, to limit the duration of the dyn_horgrid_type, and to better co-locate grid-related parameters in the parameter_doc files. Also uses the new interface to rotate_dyn_horgrid from the MOM_dyn_horgrid module in place of the rotate_dyngrid interface from the MOM_transcribe_grid module. All answers are bitwise identical, but the order of some entries in the MOM_parameter_doc files has changed. --- src/core/MOM.F90 | 94 +++++++++++++++++++++++------------------------- 1 file changed, 44 insertions(+), 50 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fd798076fa..5a1f4cf348 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -75,6 +75,7 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_dyn_horgrid, only : rotate_dyn_horgrid use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze, EOS_domain use MOM_fixed_initialization, only : MOM_initialize_fixed use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing @@ -123,7 +124,6 @@ module MOM use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state use MOM_tracer_flow_control, only : tracer_flow_control_end use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid -use MOM_transcribe_grid, only : rotate_dyngrid use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state @@ -1693,7 +1693,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(hor_index_type), pointer :: HI => NULL() ! A hor_index_type for array extents type(hor_index_type), target :: HI_in ! HI on the input grid type(verticalGrid_type), pointer :: GV => NULL() - type(dyn_horgrid_type), pointer :: dG => NULL() + type(dyn_horgrid_type), pointer :: dG => NULL(), test_dG => NULL() type(dyn_horgrid_type), pointer :: dG_in => NULL() type(diag_ctrl), pointer :: diag => NULL() type(unit_scale_type), pointer :: US => NULL() @@ -2153,8 +2153,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Swap axes for quarter and 3-quarter turns if (CS%rotate_index) then allocate(CS%G) - call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, & - domain_name="MOM_rot") + call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, domain_name="MOM_rot") first_direction = modulo(first_direction + turns, 2) else CS%G => G_in @@ -2179,19 +2178,34 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & local_indexing=.not.global_indexing) call create_dyn_horgrid(dG_in, HI_in, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(G_in%Domain, dG_in%Domain) + ! Also allocate the input ocean_grid_type type at this point based on the same information. + call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) ! Allocate initialize time-invariant MOM variables. call MOM_initialize_fixed(dG_in, US, OBC_in, param_file, .false., dirs%output_directory) + ! Copy the grid metrics and bathymetry to the ocean_grid_type + call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) + call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") - ! Determine HI and dG for the model index map. + call verticalGridInit( param_file, CS%GV, US ) + GV => CS%GV + + ! Shift from using the temporary dynamic grid type to using the final (potentially static) + ! and properly rotated ocean-specific grid type and horizontal index type. if (CS%rotate_index) then allocate(HI) call rotate_hor_index(HI_in, turns, HI) + ! NOTE: If indices are rotated, then G and G_in must both be initialized separately, and + ! the dynamic grid must be created to handle the grid rotation. G%domain has already been + ! initialzed above. + call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) call create_dyn_horgrid(dG, HI, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(G%Domain, dG%Domain) - call rotate_dyngrid(dG_in, dG, US, turns) + call rotate_dyn_horgrid(dG_in, dG, US, turns) + call copy_dyngrid_to_MOM_grid(dG, G, US) + if (associated(OBC_in)) then ! TODO: General OBC index rotations is not yet supported. if (modulo(turns, 4) /= 1) & @@ -2199,18 +2213,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & allocate(CS%OBC) call rotate_OBC_config(OBC_in, dG_in, CS%OBC, dG, turns) endif + + call destroy_dyn_horgrid(dG) else + ! If not rotated, then G_in and G are the same grid. HI => HI_in - dG => dG_in + G => G_in CS%OBC => OBC_in endif - - call verticalGridInit( param_file, CS%GV, US ) - GV => CS%GV - - ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. - if (CS%debug .or. dG%symmetric) & - call clone_MOM_domain(dG%Domain, dG%Domain_aux, symmetric=.false.) + ! dG_in is retained for now so that it can be used with write_ocean_geometry_file() below. call callTree_waypoint("grids initialized (initialize_MOM)") @@ -2219,9 +2230,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call tracer_registry_init(param_file, CS%tracer_Reg) ! Allocate and initialize space for the primary time-varying MOM variables. - is = dG%isc ; ie = dG%iec ; js = dG%jsc ; je = dG%jec ; nz = GV%ke - isd = dG%isd ; ied = dG%ied ; jsd = dG%jsd ; jed = dG%jed - IsdB = dG%IsdB ; IedB = dG%IedB ; JsdB = dG%JsdB ; JedB = dG%JedB + is = HI%isc ; ie = HI%iec ; js = HI%jsc ; je = HI%jec ; nz = GV%ke + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed + IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0 ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0 ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom_H @@ -2258,12 +2269,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else conv2salt = GV%H_to_kg_m2 endif - call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & + call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & flux_units='W', flux_longname='Heat', & flux_scale=conv2watt, convergence_units='W m-2', & convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) - call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, dG%HI, GV, & + call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_S, registry_diags=.true., flux_nameroot='S', & flux_units=S_flux_units, flux_longname='Salt', & flux_scale=conv2salt, convergence_units='kg m-2 s-1', & @@ -2336,24 +2347,24 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call restart_init(param_file, restart_CSp) call set_restart_fields(GV, US, param_file, CS, restart_CSp) if (CS%split) then - call register_restarts_dyn_split_RK2(dG%HI, GV, param_file, & + call register_restarts_dyn_split_RK2(HI, GV, param_file, & CS%dyn_split_RK2_CSp, restart_CSp, CS%uh, CS%vh) elseif (CS%use_RK2) then - call register_restarts_dyn_unsplit_RK2(dG%HI, GV, param_file, & + call register_restarts_dyn_unsplit_RK2(HI, GV, param_file, & CS%dyn_unsplit_RK2_CSp, restart_CSp) else - call register_restarts_dyn_unsplit(dG%HI, GV, param_file, & + call register_restarts_dyn_unsplit(HI, GV, param_file, & CS%dyn_unsplit_CSp, restart_CSp) endif ! This subroutine calls user-specified tracer registration routines. ! Additional calls can be added to MOM_tracer_flow_control.F90. - call call_tracer_register(dG%HI, GV, US, param_file, CS%tracer_flow_CSp, & + call call_tracer_register(HI, GV, US, param_file, CS%tracer_flow_CSp, & CS%tracer_Reg, restart_CSp) - call MEKE_alloc_register_restart(dG%HI, param_file, CS%MEKE, restart_CSp) - call set_visc_register_restarts(dG%HI, GV, param_file, CS%visc, restart_CSp) - call mixedlayer_restrat_register_restarts(dG%HI, param_file, & + call MEKE_alloc_register_restart(HI, param_file, CS%MEKE, restart_CSp) + call set_visc_register_restarts(HI, GV, param_file, CS%visc, restart_CSp) + call mixedlayer_restrat_register_restarts(HI, param_file, & CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%rotate_index .and. associated(OBC_in) .and. use_temperature) then @@ -2382,33 +2393,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This needs the number of tracers and to have called any code that sets whether ! reservoirs are used. - call open_boundary_register_restarts(dg%HI, GV, CS%OBC, CS%tracer_Reg, & + call open_boundary_register_restarts(HI, GV, CS%OBC, CS%tracer_Reg, & param_file, restart_CSp, use_temperature) endif call callTree_waypoint("restart registration complete (initialize_MOM)") call restart_registry_lock(restart_CSp) - ! Shift from using the temporary dynamic grid type to using the final - ! (potentially static) ocean-specific grid type. - ! The next line would be needed if G%Domain had not already been init'd above: - ! call clone_MOM_domain(dG%Domain, G%Domain) - - ! NOTE: If indices are rotated, then G and G_in must both be initialized. - ! If not rotated, then G_in and G are the same grid. - if (CS%rotate_index) then - call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G, US) - call destroy_dyn_horgrid(dG) - endif - call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) - if (.not. CS%rotate_index) G => G_in - + ! Write out all of the grid data used by this run. new_sim = determine_is_new_run(dirs%input_filename, dirs%restart_input_dir, G_in, restart_CSp) write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. new_sim)) - - ! Write out all of the grid data used by this run. if (write_geom_files) call write_ocean_geometry_file(dG_in, param_file, dirs%output_directory, US=US) call destroy_dyn_horgrid(dG_in) @@ -2534,16 +2528,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (test_grid_copy) then ! Copy the data from the temporary grid to the dyn_hor_grid to CS%G. - call create_dyn_horgrid(dG, G%HI) - call clone_MOM_domain(G%Domain, dG%Domain) + call create_dyn_horgrid(test_dG, G%HI) + call clone_MOM_domain(G%Domain, test_dG%Domain) call clone_MOM_domain(G%Domain, CS%G%Domain) call MOM_grid_init(CS%G, param_file, US) - call copy_MOM_grid_to_dyngrid(G, dg, US) - call copy_dyngrid_to_MOM_grid(dg, CS%G, US) + call copy_MOM_grid_to_dyngrid(G, test_dG, US) + call copy_dyngrid_to_MOM_grid(test_dG, CS%G, US) - call destroy_dyn_horgrid(dG) + call destroy_dyn_horgrid(test_dG) call MOM_grid_end(G) ; deallocate(G) G => CS%G From 688bff9c1563ab771d01b5c184ab5b56e98b0455 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Oct 2021 07:31:53 -0400 Subject: [PATCH 027/138] (*)Fix compile-time issues with MOM_sum_driver.F90 Modified drivers/unit_drivers/MOM_sum_driver.F90 to compile with the latest version of the rest of the MOM6 code by using the proper types in the various initialization calls, and verified that it runs as intended. --- .../drivers/unit_drivers/MOM_sum_driver.F90 | 39 ++++++++++++------- 1 file changed, 24 insertions(+), 15 deletions(-) diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index 7e3c6d45b4..7291eb913a 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -18,13 +18,14 @@ 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_domains, only : MOM_domains_init, MOM_infra_init, MOM_infra_end + use MOM_domains, only : MOM_domain_type, MOM_domains_init, MOM_infra_init, MOM_infra_end + use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid use MOM_error_handler, only : MOM_error, MOM_mesg, WARNING, FATAL, is_root_pe use MOM_error_handler, only : MOM_set_verbosity use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_file_parser, only : open_param_file, close_param_file - use MOM_grid, only : MOM_grid_init, ocean_grid_type use MOM_grid_initialize, only : set_grid_metrics + use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_io, only : MOM_io_init, file_exists, open_file, close_file use MOM_io, only : check_nml_error, io_infra_init, io_infra_end use MOM_io, only : APPEND_FILE, ASCII_FILE, READONLY_FILE, SINGLE_FILE @@ -33,9 +34,10 @@ program MOM_main #include - type(ocean_grid_type) :: grid ! A structure containing metrics and grid info. - - type(param_file_type) :: param_file ! The structure indicating the file(s) + type(MOM_domain_type), pointer :: Domain => NULL() !< Ocean model domain + type(dyn_horgrid_type), pointer :: grid => NULL() ! A structure containing metrics and grid info + type(hor_index_type) :: HI ! A hor_index_type for array extents + type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. real :: max_depth ! The maximum ocean depth [m] integer :: verbosity @@ -76,14 +78,16 @@ program MOM_main verbosity = 2 ; call read_param(param_file, "VERBOSITY", verbosity) call MOM_set_verbosity(verbosity) - call MOM_domains_init(grid%domain, param_file) + call MOM_domains_init(Domain, param_file) call MOM_io_init(param_file) ! call diag_mediator_init(param_file) - call MOM_grid_init(grid, param_file) + call hor_index_init(Domain, HI, param_file) + call create_dyn_horgrid(grid, HI) + grid%Domain => Domain - is = grid%isc ; ie = grid%iec ; js = grid%jsc ; je = grid%jec - isd = grid%isd ; ied = grid%ied ; jsd = grid%jsd ; jed = grid%jed + is = HI%isc ; ie = HI%iec ; js = HI%jsc ; je = HI%jec + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ! Read all relevant parameters and write them to the model log. call log_version(param_file, "MOM", version, "") @@ -99,7 +103,7 @@ program MOM_main allocate(depth_tot_std(num_sums)) ; depth_tot_std(:) = 0.0 allocate(depth_tot_fastR(num_sums)) ; depth_tot_fastR(:) = 0.0 -! Set up the parameters of the physical domain (i.e. the grid), G +! Set up the parameters of the physical grid call set_grid_metrics(grid, param_file) ! Set up the bottom depth, grid%bathyT either analytically or from file @@ -157,14 +161,16 @@ program MOM_main endif enddo + call destroy_dyn_horgrid(grid) call io_infra_end ; call MOM_infra_end 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(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters real, intent(in) :: max_depth !< The maximum ocean depth [m] @@ -172,6 +178,7 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! + real :: m_to_Z ! A dimensional rescaling factor. real :: x, y ! This include declares and sets the variable "version". # include "version_variable.h" @@ -180,12 +187,14 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) 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 log_version(param_file, mdl, version) + m_to_Z = 1.0 ! ; if (present(US)) m_to_Z = US%m_to_Z + + 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) + "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) PI = 4.0*atan(1.0) - D0 = max_depth / 0.5; + D0 = max_depth / 0.5 ! Calculate the depth of the bottom. do i=is,ie ; do j=js,je From 9341376191e881728d82df5f0b2bc1da5833812a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 16 Nov 2021 17:36:54 -0500 Subject: [PATCH 028/138] Removed Travis-CI badge from README --- README.md | 1 - 1 file changed, 1 deletion(-) diff --git a/README.md b/README.md index dfbfafc7d0..d041a47daf 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,3 @@ -[![Build Status](https://travis-ci.org/NOAA-GFDL/MOM6.svg?branch=dev/master)](https://travis-ci.org/NOAA-GFDL/MOM6) [![Read The Docs Status](https://readthedocs.org/projects/mom6/badge/?badge=latest)](http://mom6.readthedocs.io/) [![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev%2Fmaster/graph/badge.svg)](https://codecov.io/gh/NOAA-GFDL/MOM6) From 8b5e10aa7040940bd3f8356b51f612eac0465580 Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Tue, 16 Nov 2021 21:25:15 -0500 Subject: [PATCH 029/138] (+) porous topography implementation (#3) * reads in porous topography parameters from CHANNEL_LIST_FILE *new module to compute curve fit for porous topography *porous constraints used to modify continuity_PPM, CoriolisAdv, and Rayleigh bottom channel drag --- src/core/MOM.F90 | 46 ++++- src/core/MOM_CoriolisAdv.F90 | 20 ++- src/core/MOM_continuity.F90 | 7 +- src/core/MOM_continuity_PPM.F90 | 145 ++++++++------- src/core/MOM_dynamics_split_RK2.F90 | 48 +++-- src/core/MOM_dynamics_unsplit.F90 | 43 ++++- src/core/MOM_dynamics_unsplit_RK2.F90 | 41 ++++- src/core/MOM_grid.F90 | 21 +++ src/core/MOM_porous_barriers.F90 | 166 ++++++++++++++++++ src/core/MOM_transcribe_grid.F90 | 16 ++ src/core/MOM_variables.F90 | 10 ++ src/framework/MOM_dyn_horgrid.F90 | 22 +++ .../MOM_shared_initialization.F90 | 55 +++++- .../vertical/MOM_set_viscosity.F90 | 15 +- 14 files changed, 545 insertions(+), 110 deletions(-) create mode 100644 src/core/MOM_porous_barriers.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 5a1f4cf348..186c972b5e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -127,7 +127,7 @@ module MOM use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state -use MOM_variables, only : thermo_var_ptrs, vertvisc_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state use MOM_variables, only : rotate_surface_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd @@ -136,6 +136,8 @@ module MOM use MOM_wave_interface, only : wave_parameters_CS, waves_end use MOM_wave_interface, only : Update_Stokes_Drift +use MOM_porous_barriers, only : porous_widths + ! ODA modules use MOM_oda_driver_mod, only : ODA_CS, oda, init_oda, oda_end use MOM_oda_driver_mod, only : set_prior_tracer, set_analysis_time, apply_oda_tracer_increments @@ -399,6 +401,15 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors + type(porous_barrier_ptrs) :: pbv !< porous barrier fractional cell metrics + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) & + :: por_face_areaU !< fractional open area of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) & + :: por_face_areaV !< fractional open area of V-faces [nondim] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) & + :: por_layer_widthU !< fractional open width of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) & + :: por_layer_widthV !< fractional open width of V-faces [nondim] type(particles), pointer :: particles => NULL() ! m or 1/eta_to_m] 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 = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1047,13 +1060,16 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call diag_update_remap_grids(CS%diag) endif + !update porous barrier fractional cell metrics + call porous_widths(h, CS%tv, G, GV, US, eta_por, CS%pbv) + ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averages(bbl_time_int, & Time_local + real_to_time(US%T_to_s*(bbl_time_int-dt)), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, CS%set_visc_CSp) + call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, CS%set_visc_CSp, CS%pbv) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") call disable_averaging(CS%diag) @@ -1076,7 +1092,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & CS%eta_av_bc, G, GV, US, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, & - CS%MEKE, CS%thickness_diffuse_CSp, waves=waves) + CS%MEKE, CS%thickness_diffuse_CSp, CS%pbv, waves=waves) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") elseif (CS%do_dynamics) then ! ------------------------------------ not SPLIT @@ -1090,11 +1106,11 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%use_RK2) then call step_MOM_dyn_unsplit_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE, CS%pbv) else call step_MOM_dyn_unsplit(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, CS%pbv, Waves=Waves) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") @@ -1296,6 +1312,9 @@ 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 + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)+1) :: eta_por ! layer interface heights + !! for porous topo. [Z ~> m or 1/eta_to_m] + 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") @@ -1331,7 +1350,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics ! and set_viscous_BBL is called as a part of the dynamic stepping. call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp) + !update porous barrier fractional cell metrics + call porous_widths(h, CS%tv, G, GV, US, eta_por, CS%pbv) + call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp, CS%pbv) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)") endif @@ -2330,6 +2351,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 ! -G%Z_ref CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0 + !allocate porous topography variables + ALLOC_(CS%por_face_areaU(IsdB:IedB,jsd:jed,nz)) ; CS%por_face_areaU(:,:,:) = 1.0 + ALLOC_(CS%por_face_areaV(isd:ied,JsdB:JedB,nz)) ; CS%por_face_areaV(:,:,:) = 1.0 + ALLOC_(CS%por_layer_widthU(IsdB:IedB,jsd:jed,nz+1)) ; CS%por_layer_widthU(:,:,:) = 1.0 + ALLOC_(CS%por_layer_widthV(isd:ied,JsdB:JedB,nz+1)) ; CS%por_layer_widthV(:,:,:) = 1.0 + CS%pbv%por_face_areaU => CS%por_face_areaU; CS%pbv%por_face_areaV=> CS%por_face_areaV + CS%pbv%por_layer_widthU => CS%por_layer_widthU; CS%pbv%por_layer_widthV => CS%por_layer_widthV ! Use the Wright equation of state by default, unless otherwise specified ! Note: this line and the following block ought to be in a separate ! initialization routine for tv. @@ -2647,7 +2675,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & CS%thickness_diffuse_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & - CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt, cont_stencil=CS%cont_stencil) + CS%visc, dirs, CS%ntrunc, CS%pbv, calc_dtbt=calc_dtbt, cont_stencil=CS%cont_stencil) if (CS%dtbt_reset_period > 0.0) then CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. @@ -3581,6 +3609,10 @@ subroutine MOM_end(CS) if (CS%use_ALE_algorithm) call ALE_end(CS%ALE_CSp) + !deallocate porous topography variables + DEALLOC_(CS%por_face_areaU) ; DEALLOC_(CS%por_face_areaV) + DEALLOC_(CS%por_layer_widthU) ; DEALLOC_(CS%por_layer_widthV) + ! NOTE: Allocated in PressureForce_FV_Bouss if (associated(CS%tv%varT)) deallocate(CS%tv%varT) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e4d97ab53a..0de67d7159 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -14,7 +14,7 @@ module MOM_CoriolisAdv use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : accel_diag_ptrs +use MOM_variables, only : accel_diag_ptrs, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -117,7 +117,7 @@ module MOM_CoriolisAdv contains !> 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) +subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) 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] @@ -135,6 +135,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) 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(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -285,7 +286,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo !$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,vol_neglect,h_tiny,OBC,eps_vel) + !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,vol_neglect,h_tiny,OBC,eps_vel, & + !$OMP pbv) do k=1,nz ! Here the second order accurate layer potential vorticities, q, @@ -306,10 +308,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do j=Jsq,Jeq+1 ; do I=is-1,ie - uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uh_center(I,j) = 0.5 * ((G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k)) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) enddo ; enddo do J=js-1,je ; do i=Isq,Ieq+1 - vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vh_center(i,J) = 0.5 * ((G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k)) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -352,9 +354,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j,k) + vh_center(i,J) = (G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k)) * v(i,J,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j+1,k) + vh_center(i,J) = (G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k)) * v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -391,9 +393,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i,j,k) + uh_center(I,j) = (G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k)) * u(I,j,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i+1,j,k) + uh_center(I,j) = (G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k)) * u(I,j,k) * h(i+1,j,k) endif enddo endif diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 655055b03d..20f9c34d65 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -13,7 +13,7 @@ module MOM_continuity use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : BT_cont_type +use MOM_variables, only : BT_cont_type, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -39,7 +39,7 @@ module MOM_continuity !> Time steps the layer thicknesses, using a monotonically limited, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, & +subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhbt, vhbt, & 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. @@ -61,6 +61,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume !! flux through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -95,7 +96,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, " one must be present in call to continuity.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, OBC, uhbt, vhbt, & + call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, OBC, pbv, uhbt, vhbt, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d30e1af0f2..c4c96fa392 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -11,7 +11,7 @@ module MOM_continuity_PPM use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : BT_cont_type +use MOM_variables, only : BT_cont_type, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -73,7 +73,7 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, & +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhbt, vhbt, & 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. @@ -93,6 +93,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< Module's control structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(porous_barrier_ptrs), intent(in) :: pbv !< pointers to porous barrier fractional cell metrics 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]. @@ -148,7 +149,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil - call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, OBC, uhbt, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, OBC, & + pbv%por_face_areaU, uhbt, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -163,7 +165,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, OBC, vhbt, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, OBC, & + pbv%por_face_areaV, vhbt, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -179,7 +182,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, OBC, vhbt, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, OBC, & + pbv%por_face_areaV, vhbt, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -191,7 +195,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, OBC, uhbt, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, OBC, & + pbv%por_face_areaU, uhbt, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -207,7 +212,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & +subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_areaU, uhbt, & 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. @@ -223,6 +228,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] 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]. @@ -300,7 +307,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,u,h_in,h_L,h_R,use_visc_rem,visc_rem_u, & !$OMP uh,dt,US,G,GV,CS,local_specified_BC,OBC,uhbt,set_BT_cont, & -!$OMP CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC) & +!$OMP CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC, & +!$OMP por_face_areaU) & !$OMP private(do_I,duhdu,du,du_max_CFL,du_min_CFL,uh_tot_0,duhdu_tot_0, & !$OMP is_simple,FAuI,visc_rem_max,I_vrm,du_lim,dx_E,dx_W, & !$OMP any_simple_OBC,l_seg) & @@ -315,7 +323,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & enddo ; endif call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh(:,j,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), OBC) if (local_specified_BC) then do I=ish-1,ieh l_seg = OBC%segnum_u(I,j) @@ -428,7 +436,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & 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, GV, US, CS, visc_rem, & - j, ish, ieh, do_I, uh, OBC=OBC) + j, ish, ieh, do_I, por_face_areaU, uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo @@ -447,7 +455,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & 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, GV, US, CS, visc_rem, & - visc_rem_max, j, ish, ieh, do_I) + visc_rem_max, j, ish, ieh, do_I, por_face_areaU) if (any_simple_OBC) then do I=ish-1,ieh l_seg = OBC%segnum_u(I,j) @@ -456,7 +464,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & if (l_seg /= OBC_NONE) & do_I(I) = OBC%segment(l_seg)%specified - if (do_I(I)) FAuI(I) = GV%H_subroundoff*G%dy_Cu(I,j) + if (do_I(I)) FAuI(I) = GV%H_subroundoff*(G%dy_Cu(I,j)*por_face_areaU(I,j,k)) enddo ! NOTE: do_I(I) should prevent access to segment OBC_NONE do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then @@ -484,7 +492,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & if (OBC%segment(n)%direction == OBC_DIRECTION_E) then do j = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; enddo + do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*(G%dy_Cu(I,j)*por_face_areaU(I,j,k)) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 @@ -492,7 +500,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & else do j = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*G%dy_Cu(I,j) ; enddo + do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*(G%dy_Cu(I,j)*por_face_areaU(I,j,k)) ; enddo BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 @@ -506,10 +514,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & 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, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, OBC, visc_rem_u) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU(:,j,k), visc_rem_u) else 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, OBC, visc_rem_u) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU(:,j,k), visc_rem_u) endif endif ; endif @@ -517,7 +525,7 @@ end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & - ish, ieh, do_I, vol_CFL, OBC) + ish, ieh, do_I, vol_CFL, por_face_areaU, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -539,6 +547,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the + real, dimension(SZIB_(G)), intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] !! ratio of face areas to the cell areas when estimating the CFL number. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables @@ -561,21 +570,21 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I))* u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) h_marg = h_L(i+1) + CFL * ((h_R(i+1)-h_L(i+1)) + 3.0*curv_3*(CFL - 1.0)) else uh(I) = 0.0 h_marg = 0.5 * (h_L(i+1) + h_R(i)) endif - duhdu(I) = G%dy_Cu(I,j) * h_marg * visc_rem(I) + duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then @@ -585,11 +594,11 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & if (l_seg /= OBC_NONE) then if (OBC%segment(l_seg)%open) then if (OBC%segment(l_seg)%direction == OBC_DIRECTION_E) then - uh(I) = G%dy_Cu(I,j) * u(I) * h(i) - duhdu(I) = G%dy_Cu(I,j) * h(i) * visc_rem(I) + uh(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * u(I) * h(i) + duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h(i) * visc_rem(I) else - uh(I) = G%dy_Cu(I,j) * u(I) * h(i+1) - duhdu(I) = G%dy_Cu(I,j) * h(i+1) * visc_rem(I) + uh(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * u(I) * h(i+1) + duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h(i+1) * visc_rem(I) endif endif endif @@ -599,7 +608,7 @@ 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, GV, US, LB, vol_CFL, & - marginal, OBC, visc_rem_u) + marginal, OBC, por_face_areaU, visc_rem_u) 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_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -617,6 +626,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, 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)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u @@ -706,7 +717,8 @@ end subroutine zonal_face_thickness !! 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, GV, US, CS, visc_rem, & - j, ish, ieh, do_I_in, uh_3d, OBC) + j, ish, ieh, do_I_in, por_face_areaU, uh_3d, OBC) + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -742,6 +754,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I_in !< !! A logical flag indicating which I values to work on. + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] 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. @@ -826,7 +840,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL,por_face_areaU(:,j,k),OBC) enddo ; endif if (itt < max_itts) then @@ -856,7 +870,7 @@ end subroutine zonal_flux_adjust !! 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, GV, US, CS, visc_rem, & - visc_rem_max, j, ish, ieh, do_I) + visc_rem_max, j, ish, ieh, do_I, por_face_areaU) 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_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. @@ -890,6 +904,8 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I !< A logical flag indicating !! which I values to work on. + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & + intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] ! Local variables real, dimension(SZIB_(G)) :: & du0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. @@ -931,7 +947,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, 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, GV, US, CS, visc_rem, & - j, ish, ieh, do_I) + j, ish, ieh, do_I, por_face_areaU) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently ! negative velocity correction for the easterly-flux, and a sufficiently @@ -972,11 +988,11 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_0(I) = u(I,j,k) + du0(I) * visc_rem(I,k) endif ; enddo call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, duhdu_0, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL,por_face_areaU(:,j,k)) call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL,por_face_areaU(:,j,k)) do I=ish-1,ieh ; if (do_I(I)) then FAmt_0(I) = FAmt_0(I) + duhdu_0(I) FAmt_L(I) = FAmt_L(I) + duhdu_L(I) @@ -1018,7 +1034,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, 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, OBC, vhbt, & +subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_face_areaV, vhbt, & 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. @@ -1026,13 +1042,15 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & 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] + !! 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), pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] 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_(GV)), & @@ -1110,7 +1128,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,v,h_in,h_L,h_R,vh,use_visc_rem, & !$OMP visc_rem_v,dt,US,G,GV,CS,local_specified_BC,OBC,vhbt, & -!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC ) & +!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC, & +!$OMP por_face_areaV) & !$OMP private(do_I,dvhdv,dv,dv_max_CFL,dv_min_CFL,vh_tot_0, & !$OMP dvhdv_tot_0,visc_rem_max,I_vrm,dv_lim,dy_N, & !$OMP is_simple,FAvi,dy_S,any_simple_OBC,l_seg) & @@ -1125,7 +1144,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), OBC) if (local_specified_BC) then do i=ish,ieh l_seg = OBC%segnum_v(i,J) @@ -1234,7 +1253,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & 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, GV, US, CS, visc_rem, & - j, ish, ieh, do_I, vh, OBC=OBC) + j, ish, ieh, do_I, por_face_areaV, vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo @@ -1252,7 +1271,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & 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, GV, US, CS, visc_rem, & - visc_rem_max, J, ish, ieh, do_I) + visc_rem_max, J, ish, ieh, do_I, por_face_areaV) if (any_simple_OBC) then do i=ish,ieh l_seg = OBC%segnum_v(i,J) @@ -1261,7 +1280,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & if(l_seg /= OBC_NONE) & do_I(i) = (OBC%segment(l_seg)%specified) - if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) + if (do_I(i)) FAvi(i) = GV%H_subroundoff*(G%dx_Cv(i,J)*por_face_areaV(i,J,k)) enddo ! NOTE: do_I(I) should prevent access to segment OBC_NONE do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then @@ -1289,7 +1308,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & if (OBC%segment(n)%direction == OBC_DIRECTION_N) then do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*G%dx_Cv(i,J) ; enddo + do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*(G%dx_Cv(i,J)*por_face_areaV(i,J,k)) ; enddo BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1297,7 +1316,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & else do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*G%dx_Cv(i,J) ; enddo + do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*(G%dx_Cv(i,J)*por_face_areaV(i,J,k)) ; enddo BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1311,10 +1330,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & 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, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, OBC, visc_rem_v) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaV, visc_rem_v) else 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, OBC, visc_rem_v) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaV, visc_rem_v) endif endif ; endif @@ -1322,7 +1341,7 @@ end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & - ish, ieh, do_I, vol_CFL, OBC) + ish, ieh, do_I, vol_CFL, por_face_areaV, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -1348,6 +1367,8 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & logical, dimension(SZI_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the !! ratio of face areas to the cell areas when estimating the CFL number. + real, dimension(SZI_(G), SZJB_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -1368,7 +1389,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) - vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) @@ -1376,7 +1397,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) - vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) h_marg = h_L(i,j+1) + CFL * ((h_R(i,j+1)-h_L(i,j+1)) + & 3.0*curv_3*(CFL - 1.0)) @@ -1384,7 +1405,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & vh(i) = 0.0 h_marg = 0.5 * (h_L(i,j+1) + h_R(i,j)) endif - dvhdv(i) = G%dx_Cv(i,J) * h_marg * visc_rem(i) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then @@ -1394,11 +1415,11 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & if (l_seg /= OBC_NONE) then if (OBC%segment(l_seg)%open) then if (OBC%segment(l_seg)%direction == OBC_DIRECTION_N) then - vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j) - dvhdv(i) = G%dx_Cv(i,J) * h(i,j) * visc_rem(i) + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * h(i,j) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h(i,j) * visc_rem(i) else - vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j+1) - dvhdv(i) = G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) + vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * h(i,j+1) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h(i,j+1) * visc_rem(i) endif endif endif @@ -1408,7 +1429,7 @@ 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, GV, US, LB, vol_CFL, & - marginal, OBC, visc_rem_v) + marginal, OBC, por_face_areaV, visc_rem_v) 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]. @@ -1428,6 +1449,8 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, logical, intent(in) :: marginal !< If true, report the marginal !! face thicknesses; otherwise report transport-averaged thicknesses. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] 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 @@ -1516,7 +1539,7 @@ 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, GV, US, CS, visc_rem, & - j, ish, ieh, do_I_in, vh_3d, OBC) + j, ish, ieh, do_I_in, por_face_areaV, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -1551,6 +1574,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 integer, intent(in) :: ieh !< End of index range. logical, dimension(SZI_(G)), & intent(in) :: do_I_in !< A flag indicating which I values to work on. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] 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]. @@ -1636,7 +1661,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), OBC) enddo ; endif if (itt < max_itts) then @@ -1666,7 +1691,7 @@ end subroutine meridional_flux_adjust !! 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, GV, US, CS, visc_rem, & - visc_rem_max, j, ish, ieh, do_I) + visc_rem_max, j, ish, ieh, do_I, por_face_areaV) 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]. @@ -1700,6 +1725,8 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, integer, intent(in) :: ieh !< End of index range. logical, dimension(SZI_(G)), intent(in) :: do_I !< A logical flag indicating !! which I values to work on. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] ! Local variables real, dimension(SZI_(G)) :: & dv0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. @@ -1741,7 +1768,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, 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, GV, US, CS, visc_rem, & - j, ish, ieh, do_I) + j, ish, ieh, do_I, por_face_areaV) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently ! negative velocity correction for the northerly-flux, and a sufficiently @@ -1782,11 +1809,11 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_0(i) = v(I,j,k) + dv0(i) * visc_rem(i,k) endif ; enddo call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, dvhdv_0, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) do i=ish,ieh ; if (do_I(i)) then FAmt_0(i) = FAmt_0(i) + dvhdv_0(i) FAmt_L(i) = FAmt_L(i) + dvhdv_L(i) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f9d70d65d7..fa796c7fe8 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -3,7 +3,7 @@ module MOM_dynamics_split_RK2 ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_variables, only : vertvisc_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs use MOM_variables, only : BT_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing @@ -165,6 +165,7 @@ module MOM_dynamics_split_RK2 integer :: id_umo_2d = -1, id_vmo_2d = -1 integer :: id_PFu = -1, id_PFv = -1 integer :: id_CAu = -1, id_CAv = -1 + integer :: id_ueffA = -1, id_veffA = -1 ! integer :: id_hf_PFu = -1, id_hf_PFv = -1 integer :: id_h_PFu = -1, id_h_PFv = -1 integer :: id_hf_PFu_2d = -1, id_hf_PFv_2d = -1 @@ -255,7 +256,7 @@ module MOM_dynamics_split_RK2 !> RK2 splitting for time stepping MOM adiabatic dynamics subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, calc_dtbt, VarMix, & - MEKE, thickness_diffuse_CSp, Waves) + MEKE, thickness_diffuse_CSp, pbv, Waves) 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 @@ -294,6 +295,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -301,7 +303,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s 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_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] 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 @@ -395,6 +398,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo enddo + ueffA(:,:,:) = 0; veffA(:,:,:) = 0 ! Update CFL truncation value as function of time call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) @@ -485,7 +489,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv_CSp) + G, Gv, US, CS%CoriolisAdv_CSp, pbv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -562,7 +566,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, CS%OBC, & + call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv, & visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then @@ -647,7 +651,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, & + call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv, & CS%uhbt, CS%vhbt, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) @@ -738,7 +742,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp, pbv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -850,7 +854,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, & + call continuity(u, v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv, & CS%uhbt, CS%vhbt, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) @@ -906,6 +910,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%id_u_BT_accel > 0) call post_data(CS%id_u_BT_accel, CS%u_accel_bt, CS%diag) if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) + ! Calculate effective areas and post data + if (CS%id_ueffA > 0) then + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) + endif + + if (CS%id_veffA > 0) then + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) + endif + + ! Diagnostics for terms multiplied by fractional thicknesses ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. @@ -1238,7 +1258,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, thickness_diffuse_CSp, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & - visc, dirs, ntrunc, calc_dtbt, cont_stencil) + visc, dirs, ntrunc, pbv, calc_dtbt, cont_stencil) 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 @@ -1278,6 +1298,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param !! the number of times the velocity is !! truncated (this should be 0). logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics integer, intent(out) :: cont_stencil !< The stencil for thickness !! from the continuity solver. @@ -1474,7 +1495,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC) + call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) do k=1,nz ; do j=jsd,jed ; do i=isd,ied CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) @@ -1519,6 +1540,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & + 'Effective U-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + y_cell_method='sum', v_extensive = .true.) + CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & + 'Effective V-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + x_cell_method='sum', v_extensive = .true.) + !CS%id_hf_PFu = register_diag_field('ocean_model', 'hf_PFu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Pressure Force Acceleration', & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 48d767e1a8..7cfc9d649c 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -50,7 +50,7 @@ module MOM_dynamics_unsplit !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -128,6 +128,7 @@ module MOM_dynamics_unsplit !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 + integer :: id_ueffA = -1, id_veffA = -1 integer :: id_PFu = -1, id_PFv = -1, id_CAu = -1, id_CAv = -1 !>@} @@ -186,7 +187,7 @@ module MOM_dynamics_unsplit !! 3rd order (for the inviscid momentum equations) order scheme subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & - VarMix, MEKE, Waves) + VarMix, MEKE, pbv, Waves) 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 @@ -221,6 +222,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! that specify the spatially variable viscosities. type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale Eddy Kinetic Energy. + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -228,6 +230,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] 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]. @@ -240,6 +244,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 + ueffA(:,:,:) = 0; veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -265,7 +270,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -302,7 +307,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -355,7 +360,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, CS%continuity_CSp, CS%OBC) + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -368,7 +373,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -415,7 +420,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(upp, vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, CS%continuity_CSp, CS%OBC) + call continuity(upp, vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -430,6 +435,22 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) call enable_averages(dt, Time_local, CS%diag) +! Calculate effective areas and post data + if (CS%id_ueffA > 0) then + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) + endif + + if (CS%id_veffA > 0) then + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) + endif + + ! h_av = (h + hp)/2 do k=1,nz do j=js-2,je+2 ; do i=is-2,ie+2 @@ -446,7 +467,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -684,6 +705,12 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & + 'Effective U Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + y_cell_method='sum', v_extensive = .true.) + CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & + 'Effective V Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + x_cell_method='sum', v_extensive = .true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e6fec7f61e..a7d9abc856 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -48,7 +48,7 @@ module MOM_dynamics_unsplit_RK2 !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs use MOM_variables, only : ocean_internal_state, accel_diag_ptrs, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -130,6 +130,7 @@ module MOM_dynamics_unsplit_RK2 !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 + integer :: id_ueffA = -1, id_veffA = -1 integer :: id_PFu = -1, id_PFv = -1, id_CAu = -1, id_CAv = -1 !>@} @@ -188,7 +189,7 @@ module MOM_dynamics_unsplit_RK2 !> Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & - VarMix, MEKE) + VarMix, MEKE, pbv) 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 @@ -234,10 +235,13 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale !! Eddy Kinetic Energy. + type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables 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(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] 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] @@ -250,6 +254,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 + ueffA(:,:,:) = 0; veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -281,7 +286,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_continuity) ! This is a duplicate calculation of the last continuity from the previous step ! and could/should be optimized out. -AJA - call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, CS%OBC) + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -296,7 +301,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp, pbv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) (function of h[n-1/2]) @@ -350,7 +355,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -366,7 +371,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp, pbv) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) @@ -405,7 +410,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, h_in, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -448,6 +453,22 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) +! Calculate effective areas and post data + if (CS%id_ueffA > 0) then + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) + endif + + if (CS%id_veffA > 0) then + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) + endif + + end subroutine step_MOM_dyn_unsplit_RK2 ! ============================================================================= @@ -645,6 +666,12 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) + CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & + 'Effective U-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + y_cell_method='sum', v_extensive = .true.) + CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & + 'Effective V-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + x_cell_method='sum', v_extensive = .true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 7592dc8477..90482c6754 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -112,6 +112,16 @@ module MOM_grid IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & + porous_DminU, & !< minimum topographic height of U-face [m] + porous_DmaxU, & !< maximum topographic height of U-face [m] + porous_DavgU !< average topographic height of U-face [m] + + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & + porous_DminV, & !< minimum topographic height of V-face [m] + porous_DmaxV, & !< maximum topographic height of V-face [m] + porous_DavgV !< average topographic height of V-face [m] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. @@ -574,6 +584,14 @@ subroutine allocate_metrics(G) ALLOC_(G%dx_Cv(isd:ied,JsdB:JedB)) ; G%dx_Cv(:,:) = 0.0 ALLOC_(G%dy_Cu(IsdB:IedB,jsd:jed)) ; G%dy_Cu(:,:) = 0.0 + ALLOC_(G%porous_DminU(IsdB:IedB,jsd:jed)); G%porous_DminU(:,:) = 0.0 + ALLOC_(G%porous_DmaxU(IsdB:IedB,jsd:jed)); G%porous_DmaxU(:,:) = 0.0 + ALLOC_(G%porous_DavgU(IsdB:IedB,jsd:jed)); G%porous_DavgU(:,:) = 0.0 + + ALLOC_(G%porous_DminV(isd:ied,JsdB:JedB)); G%porous_DminV(:,:) = 0.0 + ALLOC_(G%porous_DmaxV(isd:ied,JsdB:JedB)); G%porous_DmaxV(:,:) = 0.0 + ALLOC_(G%porous_DavgV(isd:ied,JsdB:JedB)); G%porous_DavgV(:,:) = 0.0 + ALLOC_(G%areaCu(IsdB:IedB,jsd:jed)) ; G%areaCu(:,:) = 0.0 ALLOC_(G%areaCv(isd:ied,JsdB:JedB)) ; G%areaCv(:,:) = 0.0 ALLOC_(G%IareaCu(IsdB:IedB,jsd:jed)) ; G%IareaCu(:,:) = 0.0 @@ -630,6 +648,9 @@ subroutine MOM_grid_end(G) DEALLOC_(G%dF_dx) ; DEALLOC_(G%dF_dy) DEALLOC_(G%sin_rot) ; DEALLOC_(G%cos_rot) + DEALLOC_(G%porous_DminU) ; DEALLOC_(G%porous_DmaxU) ; DEALLOC_(G%porous_DavgU) + DEALLOC_(G%porous_DminV) ; DEALLOC_(G%porous_DmaxV) ; DEALLOC_(G%porous_DavgV) + deallocate(G%gridLonT) ; deallocate(G%gridLatT) deallocate(G%gridLonB) ; deallocate(G%gridLatB) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 new file mode 100644 index 0000000000..4220f2c462 --- /dev/null +++ b/src/core/MOM_porous_barriers.F90 @@ -0,0 +1,166 @@ +!> Function for calculating curve fit for porous topography. +!written by sjd +module MOM_porous_barriers + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, porous_barrier_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_interface_heights, only : find_eta + +implicit none ; private + +#include + +public porous_widths + +!> Calculates curve fit from D_min, D_max, D_avg +interface porous_widths + module procedure por_widths, calc_por_layer +end interface porous_widths + +contains + +subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) + !eta_bt, halo_size, eta_to_m not currently used + !variables needed to call find_eta + 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 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)), 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. + !! thicknesses when calculating interfaceheights [H ~> m or kg m-2]. + integer, optional, intent(in) :: halo_size !< width of halo points on + !! which to calculate eta. + + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is US%Z_to_m. + type(porous_barrier_ptrs), intent(inout) :: pbv !< porous barrier fractional cell metrics + + !local variables + integer ii, i, j, k, nk, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + real w_layer, & ! fractional open width of layer interface [nondim] + A_layer, & ! integral of fractional open width from bottom to current layer[nondim] + A_layer_prev, & ! integral of fractional open width from bottom to previous layer [nondim] + eta_s, & ! layer height used for fit [Z ~> m] + eta_prev ! interface height of previous layer [Z ~> m] + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed + IsdB = G%IsdB; IedB = G%IedB; JsdB = G%JsdB; JedB = G%JedB + + !eta is zero at surface and decreases downward + !all calculations are done in [m] + + nk = SZK_(G) + + !currently no treatment for using optional find_eta arguments if present + call find_eta(h, tv, G, GV, US, eta) + + do I=IsdB,IedB; do j=jsd,jed + if (G%porous_DavgU(I,j) < 0.) then + do K = nk+1,1,-1 + eta_s = max(US%Z_to_m*eta(I,j,K), US%Z_to_m*eta(I+1,j,K)) !take shallower layer height + !eta_s = 0.5 * (US%Z_to_m*eta(I,j,K) + US%Z_to_m*eta(I+1,j,K)) !take arithmetic mean + if (eta_s <= G%porous_DminU(I,j)) then + pbv%por_layer_widthU(I,j,K) = 0.0 + A_layer_prev = 0.0 + if (K < nk+1) then + pbv%por_face_areaU(I,j,k) = 0.0; endif + else + call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j),& + eta_s, w_layer, A_layer) + pbv%por_layer_widthU(I,j,K) = w_layer + if (k <= nk) then + if ((eta_s - eta_prev) > 0.0) then + pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev)/& + (eta_s-eta_prev) + else + pbv%por_face_areaU(I,j,k) = 0.0; endif + endif + eta_prev = eta_s + A_layer_prev = A_layer + endif; enddo + endif; enddo; enddo + + do i=isd,ied; do J=JsdB,JedB + if (G%porous_DavgV(i,J) < 0.) then + do K = nk+1,1,-1 + eta_s = max(US%Z_to_m*eta(i,J,K), US%Z_to_m*eta(i,J+1,K)) !take shallower layer height + !eta_s = 0.5 * (US%Z_to_m*eta(i,J,K) + US%Z_to_m*eta(i,J+1,K)) !take arithmetic mean + if (eta_s <= G%porous_DminV(i,J)) then + pbv%por_layer_widthV(i,J,K) = 0.0 + A_layer_prev = 0.0 + if (K < nk+1) then + pbv%por_face_areaV(i,J,k) = 0.0; endif + else + call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J),& + eta_s, w_layer, A_layer) + pbv%por_layer_widthV(i,J,K) = w_layer + if (k <= nk) then + if ((eta_s - eta_prev) > 0.0) then + pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev)/& + (eta_s-eta_prev) + else + pbv%por_face_areaU(I,j,k) = 0.0; endif + endif + eta_prev = eta_s + A_layer_prev = A_layer + endif; enddo + endif; enddo; enddo + +end subroutine por_widths + +subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) +!subroutine to calculate the profile fit for a layer + + real, intent(in) :: D_min !< minimum topographic height [m] + real, intent(in) :: D_max !< maximum topographic height [m] + real, intent(in) :: D_avg !< mean topographic height [m] + real, intent(in) :: eta_layer !< height of interface [m] + real, intent(out) :: w_layer !< frac. open interface width of current layer [nondim] + real, intent(out) :: A_layer !< frac. open face area of current layer [nondim] + !local variables + real m, a, & !convenience constant for fit [nondim] + zeta, & !normalized vertical coordinate [nondim] + psi, & !fractional width of layer between Dmin and Dmax [nondim] + psi_int !integral of psi from 0 to zeta + + !three parameter fit from Adcroft 2013 + m = (D_avg - D_min)/(D_max - D_min) + a = (1. - m)/m + + zeta = (eta_layer - D_min)/(D_max - D_min) + + if (eta_layer <= D_min) then + w_layer = 0.0 + A_layer = 0.0 + elseif (eta_layer >= D_max) then + w_layer = 1.0 + A_layer = eta_layer - D_avg + else + if (m < 0.5) then + psi = zeta**(1./a) + psi_int = (1.-m)*zeta**(1./(1.-m)) + elseif (m == 0.5) then + psi = zeta + psi_int = 0.5*zeta*zeta + else + psi = 1. - (1. - zeta)**a + psi_int = zeta - m + m*((1-zeta)**(1/m)) + endif + w_layer = psi + A_layer = (D_max - D_min)*psi_int + endif + + +end subroutine calc_por_layer + +end module MOM_porous_barriers diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index d3447f6590..e19df5b6c6 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -71,6 +71,10 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dyCu(I,j) = dG%dyCu(I+ido,j+jdo) oG%dy_Cu(I,j) = dG%dy_Cu(I+ido,j+jdo) + oG%porous_DminU(I,j) = dG%porous_DminU(I+ido,j+jdo) + oG%porous_DmaxU(I,j) = dG%porous_DmaxU(I+ido,j+jdo) + oG%porous_DavgU(I,j) = dG%porous_DavgU(I+ido,j+jdo) + oG%mask2dCu(I,j) = dG%mask2dCu(I+ido,j+jdo) oG%areaCu(I,j) = dG%areaCu(I+ido,j+jdo) oG%IareaCu(I,j) = dG%IareaCu(I+ido,j+jdo) @@ -83,6 +87,10 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dyCv(i,J) = dG%dyCv(i+ido,J+jdo) oG%dx_Cv(i,J) = dG%dx_Cv(i+ido,J+jdo) + oG%porous_DminV(i,J) = dG%porous_DminV(i+ido,J+jdo) + oG%porous_DmaxV(i,J) = dG%porous_DmaxV(i+ido,J+jdo) + oG%porous_DavgV(i,J) = dG%porous_DavgV(i+ido,J+jdo) + oG%mask2dCv(i,J) = dG%mask2dCv(i+ido,J+jdo) oG%areaCv(i,J) = dG%areaCv(i+ido,J+jdo) oG%IareaCv(i,J) = dG%IareaCv(i+ido,J+jdo) @@ -216,6 +224,10 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dyCu(I,j) = oG%dyCu(I+ido,j+jdo) dG%dy_Cu(I,j) = oG%dy_Cu(I+ido,j+jdo) + dG%porous_DminU(I,j) = oG%porous_DminU(I+ido,j+jdo) + dG%porous_DmaxU(I,j) = oG%porous_DmaxU(I+ido,j+jdo) + dG%porous_DavgU(I,j) = oG%porous_DavgU(I+ido,j+jdo) + dG%mask2dCu(I,j) = oG%mask2dCu(I+ido,j+jdo) dG%areaCu(I,j) = oG%areaCu(I+ido,j+jdo) dG%IareaCu(I,j) = oG%IareaCu(I+ido,j+jdo) @@ -228,6 +240,10 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dyCv(i,J) = oG%dyCv(i+ido,J+jdo) dG%dx_Cv(i,J) = oG%dx_Cv(i+ido,J+jdo) + dG%porous_DminV(i,J) = oG%porous_DminU(i+ido,J+jdo) + dG%porous_DmaxV(i,J) = oG%porous_DmaxU(i+ido,J+jdo) + dG%porous_DavgV(i,J) = oG%porous_DavgU(i+ido,J+jdo) + dG%mask2dCv(i,J) = oG%mask2dCv(i+ido,J+jdo) dG%areaCv(i,J) = oG%areaCv(i+ido,J+jdo) dG%IareaCv(i,J) = oG%IareaCv(i+ido,J+jdo) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 363f3eebfb..aff5a5438f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -304,6 +304,16 @@ module MOM_variables type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates end type BT_cont_type + +!> pointers to grids modifying cell metric at porous barriers +type, public :: porous_barrier_ptrs + real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] +end type porous_barrier_ptrs + + contains !> Allocates the fields for the surface (return) properties of diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index c7db67ee17..49d3dc01c7 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -109,6 +109,16 @@ module MOM_dyn_horgrid IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. + real, allocatable, dimension(:,:) :: & + porous_DminU, & !< minimum topographic height of U-face [m] + porous_DmaxU, & !< maximum topographic height of U-face [m] + porous_DavgU !< average topographic height of U-face [m] + + real, allocatable, dimension(:,:) :: & + porous_DminV, & !< minimum topographic height of V-face [m] + porous_DmaxV, & !< maximum topographic height of V-face [m] + porous_DavgV !< average topographic height of V-face [m] + real, allocatable, dimension(:,:) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. @@ -256,6 +266,15 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) allocate(G%IareaCu(IsdB:IedB,jsd:jed), source=0.0) allocate(G%IareaCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%porous_DminU(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%porous_DmaxU(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%porous_DavgU(IsdB:IedB,jsd:jed), source=0.0) + + allocate(G%porous_DminV(isd:ied,JsdB:JedB), source=0.0) + allocate(G%porous_DmaxV(isd:ied,JsdB:JedB), source=0.0) + allocate(G%porous_DavgV(isd:ied,JsdB:JedB), source=0.0) + + allocate(G%bathyT(isd:ied, jsd:jed), source=0.0) allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB), source=0.0) allocate(G%dF_dx(isd:ied, jsd:jed), source=0.0) @@ -489,6 +508,9 @@ subroutine destroy_dyn_horgrid(G) deallocate(G%dx_Cv) ; deallocate(G%dy_Cu) + deallocate(G%porous_DminU) ; deallocate(G%porous_DmaxU) ; deallocate(G%porous_DavgU) + deallocate(G%porous_DminV) ; deallocate(G%porous_DmaxV) ; deallocate(G%porous_DavgV) + deallocate(G%bathyT) ; deallocate(G%CoriolisBu) deallocate(G%dF_dx) ; deallocate(G%dF_dy) deallocate(G%sin_rot) ; deallocate(G%cos_rot) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index c252e296a5..e9531bb4e2 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -850,6 +850,10 @@ subroutine reset_face_lengths_list(G, param_file, US) integer, allocatable, dimension(:) :: & u_line_no, v_line_no, & ! The line numbers in lines of u- and v-face lines u_line_used, v_line_used ! The number of times each u- and v-line is used. + real, allocatable, dimension(:) :: & + Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] + real, allocatable, dimension(:) :: & + Dmin_v, Dmax_v, Davg_v real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] real :: lat, lon ! The latitude and longitude of a point. @@ -865,6 +869,9 @@ subroutine reset_face_lengths_list(G, param_file, US) integer :: ios, iounit, isu, isv integer :: last, num_lines, nl_read, ln, npt, u_pt, v_pt integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + integer :: isu_por, isv_por + logical :: found_u_por, found_v_por + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -929,6 +936,14 @@ subroutine reset_face_lengths_list(G, param_file, US) allocate(v_line_used(num_lines), source=0) allocate(v_line_no(num_lines), source=0) + allocate(Dmin_u(num_lines)) ; Dmin_u(:) = 0.0 + allocate(Dmax_u(num_lines)) ; Dmax_u(:) = 0.0 + allocate(Davg_u(num_lines)) ; Davg_u(:) = 0.0 + + allocate(Dmin_v(num_lines)) ; Dmin_v(:) = 0.0 + allocate(Dmax_v(num_lines)) ; Dmax_v(:) = 0.0 + allocate(Davg_v(num_lines)) ; Davg_v(:) = 0.0 + ! Actually read the lines. if (is_root_pe()) then call read_face_length_list(iounit, filename, nl_read, lines) @@ -946,13 +961,21 @@ subroutine reset_face_lengths_list(G, param_file, US) line = lines(ln) ! Detect keywords found_u = .false.; found_v = .false. + found_u_por = .false.; found_v_por = .false. isu = index(uppercase(line), "U_WIDTH" ); if (isu > 0) found_u = .true. isv = index(uppercase(line), "V_WIDTH" ); if (isv > 0) found_v = .true. + isu_por = index(uppercase(line), "U_WIDTH_POR" ); if (isu_por > 0) found_u_por = .true. + isv_por = index(uppercase(line), "V_WIDTH_POR" ); if (isv_por > 0) found_v_por = .true. ! Store and check the relevant values. if (found_u) then u_pt = u_pt + 1 - read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) + if (found_u_por .eqv. .false.) then + read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) + elseif (found_u_por) then + read(line(isu_por+12:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt), & + Dmin_u(u_pt), Dmax_u(u_pt), Davg_u(u_pt) + endif u_line_no(u_pt) = ln if (is_root_PE()) then if (check_360) then @@ -977,10 +1000,19 @@ subroutine reset_face_lengths_list(G, param_file, US) call MOM_error(WARNING, "reset_face_lengths_list : Negative "//& "u-width found when reading line "//trim(line)//" from file "//& trim(filename)) + if (Dmin_u(u_pt) > Dmax_u(u_pt)) & + call MOM_error(WARNING, "reset_face_lengths_list : Out-of-order "//& + "topographical min/max found when reading line "//trim(line)//" from file "//& + trim(filename)) endif elseif (found_v) then v_pt = v_pt + 1 - read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) + if (found_v_por .eqv. .false.) then + read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) + elseif (found_v_por) then + read(line(isv+12:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt), & + Dmin_v(v_pt), Dmax_v(v_pt), Davg_v(v_pt) + endif v_line_no(v_pt) = ln if (is_root_PE()) then if (check_360) then @@ -1005,6 +1037,10 @@ subroutine reset_face_lengths_list(G, param_file, US) call MOM_error(WARNING, "reset_face_lengths_list : Negative "//& "v-width found when reading line "//trim(line)//" from file "//& trim(filename)) + if (Dmin_v(v_pt) > Dmax_v(v_pt)) & + call MOM_error(WARNING, "reset_face_lengths_list : Out-of-order "//& + "topographical min/max found when reading line "//trim(line)//" from file "//& + trim(filename)) endif endif enddo @@ -1023,6 +1059,10 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(L_to_m*G%dyCu(I,j), max(u_width(npt), 0.0)) + G%porous_DminU(I,j) = Dmin_u(npt) + G%porous_DmaxU(I,j) = Dmax_u(npt) + G%porous_DavgU(I,j) = Davg_u(npt) + if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then write(stdout,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -1032,6 +1072,9 @@ subroutine reset_face_lengths_list(G, param_file, US) write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",L_to_m*G%dy_Cu(I,j),"m" + write(stdout,'(A,3F8.2,A)') & + "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminU(I,j),& + G%porous_DmaxU(I,j), G%porous_DavgU(I,j),")m" endif endif endif @@ -1053,6 +1096,9 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(L_to_m*G%dxCv(i,J), max(v_width(npt), 0.0)) + G%porous_DminV(i,J) = Dmin_v(npt) + G%porous_DmaxV(i,J) = Dmax_v(npt) + G%porous_DavgV(i,J) = Davg_v(npt) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(stdout,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1062,6 +1108,9 @@ subroutine reset_face_lengths_list(G, param_file, US) write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",L_to_m*G%dx_Cv(I,j),"m" + write(stdout,'(A,3F8.2,A)') & + "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminV(i,J),& + G%porous_DmaxV(i,J), G%porous_DavgV(i,J),")m" endif endif endif @@ -1097,6 +1146,8 @@ subroutine reset_face_lengths_list(G, param_file, US) deallocate(u_line_used, v_line_used, u_line_no, v_line_no) deallocate(u_lat) ; deallocate(u_lon) ; deallocate(u_width) deallocate(v_lat) ; deallocate(v_lon) ; deallocate(v_width) + deallocate(Dmin_u) ; deallocate(Dmax_u) ; deallocate(Davg_u) + deallocate(Dmin_v) ; deallocate(Dmax_v) ; deallocate(Davg_v) endif call callTree_leave(trim(mdl)//'()') diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1cf3b5ddc9..60d9d49d7c 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -23,7 +23,7 @@ module MOM_set_visc use MOM_restart, only : register_restart_field_as_obsolete use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E @@ -115,7 +115,7 @@ module MOM_set_visc contains !> Calculates the thickness of the bottom boundary layer and the viscosity within that layer. -subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) +subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) 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 @@ -132,6 +132,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) !! related fields. type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to set_visc_init. + type(porous_barrier_ptrs),intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables real, dimension(SZIB_(G)) :: & @@ -373,7 +374,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,US,CS,Rml,nz,nkmb, & !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & - !$OMP OBC,maxitt,D_u,D_v,mask_u,mask_v) & + !$OMP OBC,maxitt,D_u,D_v,mask_u,mask_v, pbv) & !$OMP firstprivate(Vol_quit) do j=Jsq,Jeq ; do m=1,2 @@ -903,6 +904,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) endif ! end of a<0 cases. endif + !modify L(K) for porous barrier parameterization + if (m==1) then ; L(K) = L(K)*pbv%por_layer_widthU(I,j,K) + else ; L(K) = L(K)*pbv%por_layer_widthV(i,J,K); endif + ! Determine the drag contributing to the bottom boundary layer ! and the Raleigh drag that acts on each layer. if (L(K) > L(K+1)) then @@ -913,8 +918,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) BBL_frac = 0.0 endif - if (m==1) then ; Cell_width = G%dy_Cu(I,j) - else ; Cell_width = G%dx_Cv(i,J) ; endif + if (m==1) then ; Cell_width = G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k) + else ; Cell_width = G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k) ; endif gam = 1.0 - L(K+1)/L(K) Rayleigh = US%L_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & From d7b2e3236e04258558b2b8fcf2222b8dce537267 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 10 Nov 2021 12:08:26 -0500 Subject: [PATCH 030/138] Disable clock sync of in-loop BML timers This patch overrides the default clock sync (configured in FMS) for the CPU clocks inside of the bulk mixed layer's loops. This prevents model hangs due to an inconsistent number of clock syncs when different ranks have different size domains. --- .../vertical/MOM_bulk_mixed_layer.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 137294eda1..96b1d66374 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -3628,15 +3628,21 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) if (CS%id_ML_depth > 0) call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) if (CS%allow_clocks_in_omp_loops) then - id_clock_detrain = cpu_clock_id('(Ocean mixed layer detrain)', grain=CLOCK_ROUTINE) - id_clock_mech = cpu_clock_id('(Ocean mixed layer mechanical entrainment)', grain=CLOCK_ROUTINE) - id_clock_conv = cpu_clock_id('(Ocean mixed layer convection)', grain=CLOCK_ROUTINE) + id_clock_detrain = cpu_clock_id('(Ocean mixed layer detrain)', & + sync=.false., grain=CLOCK_ROUTINE) + id_clock_mech = cpu_clock_id('(Ocean mixed layer mechanical entrainment)', & + sync=.false., grain=CLOCK_ROUTINE) + id_clock_conv = cpu_clock_id('(Ocean mixed layer convection)', & + sync=.false., grain=CLOCK_ROUTINE) if (CS%ML_resort) then - id_clock_resort = cpu_clock_id('(Ocean mixed layer resorting)', grain=CLOCK_ROUTINE) + id_clock_resort = cpu_clock_id('(Ocean mixed layer resorting)', & + sync=.false., grain=CLOCK_ROUTINE) else - id_clock_adjustment = cpu_clock_id('(Ocean mixed layer convective adjustment)', grain=CLOCK_ROUTINE) + id_clock_adjustment = cpu_clock_id('(Ocean mixed layer convective adjustment)', & + sync=.false., grain=CLOCK_ROUTINE) endif - id_clock_EOS = cpu_clock_id('(Ocean mixed layer EOS)', grain=CLOCK_ROUTINE) + id_clock_EOS = cpu_clock_id('(Ocean mixed layer EOS)', & + sync=.false., grain=CLOCK_ROUTINE) endif if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) & From 26b1d967d5b78a2c76064ee3f880e4131dc3fdc3 Mon Sep 17 00:00:00 2001 From: He Wang Date: Thu, 18 Nov 2021 13:46:22 -0500 Subject: [PATCH 031/138] Correct a couple of typos in hor_visc 1. Three typos are corrected. 2. An if-statement for better bound of the Laplacian viscosity at h-cell is moved outside of the do-loops. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index db2514576d..e0ec7fba63 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1002,16 +1002,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! Newer method of bounding for stability - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - if (CS%better_bound_Kh) then + if (CS%better_bound_Kh) then + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xx(i,j)) then visc_bound_rem(i,j) = 0.0 Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xx(i,j) else visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xx(i,j)) endif - endif - enddo ; enddo + enddo ; enddo + endif if (CS%id_Kh_h>0 .or. CS%debug) then do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1914,7 +1914,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) "MOM_hor_visc.F90, hor_visc_init:"//& "LEITH_KH must be True when USE_QG_LEITH_VISC=True.") - !### The following two get_param_calls need to occur after Leith_Ah is read, but for now it replciates prior code. + !### The following two get_param_calls need to occur after Leith_Ah is read, but for now it replicates prior code. CS%Leith_Ah = .false. call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & "If true, include the beta term in the Leith nonlinear eddy viscosity.", & @@ -2040,7 +2040,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) fail_if_missing=CS%Leith_Ah, do_not_log=.not.CS%Leith_Ah) call get_param(param_file, mdl, "USE_LAND_MASK_FOR_HVISC", CS%use_land_mask, & - "If true, use Use the land mask for the computation of thicknesses "//& + "If true, use the land mask for the computation of thicknesses "//& "at velocity locations. This eliminates the dependence on arbitrary "//& "values over land or outside of the domain.", default=.true.) call get_param(param_file, mdl, "HORVISC_BOUND_COEF", CS%bound_coef, & @@ -2802,7 +2802,7 @@ end subroutine hor_visc_end !! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) !! & = & !! \partial_x \left( \frac{1}{2} \sigma_S \right) -!! + \partial_y \left( \frac{1}{2} \sigma_T \right) +!! + \partial_y \left( - \frac{1}{2} \sigma_T \right) !! \\\\ !! & = & !! \partial_x \left( \kappa_h \dot{e}_S \right) From e2e57872ce5555ce0b32175168fddaf220fcddb3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 12 Nov 2021 21:16:20 -0500 Subject: [PATCH 032/138] Corrected the units of 124 variables Corrected the units in comments describing 124 variables in 39 files. In addition three unused variables were eliminated. All answers and output are bitwise identical. --- src/ALE/MOM_ALE.F90 | 26 ++++++++-------- src/core/MOM.F90 | 2 +- src/core/MOM_CoriolisAdv.F90 | 4 +-- src/core/MOM_PressureForce_FV.F90 | 14 +++++---- src/core/MOM_PressureForce_Montgomery.F90 | 6 ++-- src/core/MOM_barotropic.F90 | 12 +++---- src/core/MOM_continuity_PPM.F90 | 14 ++++----- src/core/MOM_density_integrals.F90 | 2 +- src/core/MOM_dynamics_split_RK2.F90 | 5 --- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 31 ++++++++++++------- src/diagnostics/MOM_PointAccel.F90 | 17 +++++----- src/diagnostics/MOM_diagnostics.F90 | 10 +++--- src/diagnostics/MOM_sum_output.F90 | 2 +- src/diagnostics/MOM_wave_speed.F90 | 8 ++--- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 4 +-- src/equation_of_state/MOM_EOS_linear.F90 | 4 +-- src/ice_shelf/MOM_ice_shelf.F90 | 6 ++-- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 8 ++--- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +-- .../lateral/MOM_internal_tides.F90 | 16 +++++----- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_CVMix_shear.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 16 +++++----- .../vertical/MOM_diabatic_aux.F90 | 4 +-- .../vertical/MOM_diapyc_energy_req.F90 | 21 +++++++------ .../vertical/MOM_energetic_PBL.F90 | 18 ++++++----- .../vertical/MOM_entrain_diffusive.F90 | 4 +-- .../vertical/MOM_full_convection.F90 | 7 +++-- .../vertical/MOM_geothermal.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 10 +++--- src/tracer/MOM_lateral_boundary_diffusion.F90 | 8 ++--- src/tracer/MOM_neutral_diffusion.F90 | 7 +++-- src/tracer/MOM_tracer_advect.F90 | 6 ++-- src/tracer/MOM_tracer_registry.F90 | 4 +-- src/tracer/RGC_tracer.F90 | 2 +- src/user/MOM_wave_interface.F90 | 2 +- src/user/SCM_CVMix_tests.F90 | 4 +-- 39 files changed, 164 insertions(+), 154 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 93696d3879..70e152932c 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -293,7 +293,7 @@ subroutine adjustGridForIntegrity( CS, G, GV, h ) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid thickness that - !! are to be adjusted [H ~> m or kg-2] + !! are to be adjusted [H ~> m or kg m-2] call inflate_vanished_layers_old( CS%regridCS, G, GV, h(:,:,:) ) end subroutine adjustGridForIntegrity @@ -334,7 +334,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta_preale - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg m-2] integer :: nk, i, j, k, isc, iec, jsc, jec logical :: ice_shelf @@ -405,7 +405,7 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, OBC, dt) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -413,7 +413,7 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, OBC, dt) real, optional, intent(in) :: dt !< Time step between calls to ALE_main [T ~> s] ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg m-2] integer :: nk, i, j, k, isc, iec, jsc, jec nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec @@ -540,10 +540,10 @@ subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options type(ocean_OBC_type), pointer :: OBC !< Open boundary structure @@ -615,7 +615,7 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variable structure real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg-2] + !! last time step [H ~> m or kg m-2] logical, optional, intent(in) :: debug !< If true, show the call tree real, dimension(SZI_(G),SZJ_(G)), optional, intent(in):: frac_shelf_h !< Fractional ice shelf coverage [nondim] ! Local variables @@ -654,7 +654,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Original thicknesses [H ~> m or kg-2] + intent(inout) :: h !< Original thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS) integer, intent(in) :: n !< Number of times to regrid real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -741,14 +741,14 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(in) :: dxInterface !< Change in interface position - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -940,10 +940,10 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure integer, intent(in) :: nk_src !< Number of levels on source grid real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid - !! [H ~> m or kg-2] + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid logical, optional, intent(in) :: all_cells !< If false, only reconstruct for !! non-vanished cells. Use all vanished diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 5a1f4cf348..112613dc88 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3541,7 +3541,7 @@ subroutine get_MOM_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp) type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type real, optional, intent(out) :: C_p !< The heat capacity [J kg degC-1] real, optional, intent(out) :: C_p_scaled !< The heat capacity in scaled - !! units [Q degC-1 ~> J kg degC-1] + !! units [Q degC-1 ~> J kg-1 degC-1] logical, optional, intent(out) :: use_temp !< True if temperature is a state variable if (present(G)) G => CS%G_in diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e4d97ab53a..3a3ba6920c 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -169,7 +169,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) ! [H L2 T-1 ~> m3 s-1 or kg s-1]. ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb - ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. + ! discretization [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! Contributions to the circulation around q-points [L2 T-1 ~> m2 s-1] rel_vort, & ! Relative vorticity at q-points [T-1 ~> s-1]. @@ -218,7 +218,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: Heff3, Heff4 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. real :: UHeff, VHeff ! More temporary variables [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: QUHeff,QVHeff ! More temporary variables [H L2 T-1 s-1 ~> m3 s-2 or kg s-2]. + real :: QUHeff,QVHeff ! More temporary variables [H L2 T-2 ~> m3 s-2 or kg s-2]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz ! Diagnostics for fractional thickness-weighted terms diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 1963d3f2c5..3100699e6f 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -80,7 +80,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ 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] + 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 [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] @@ -109,9 +109,9 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ 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 - ! the pressure anomaly at the top of the layer [R L4 Z-4 ~> Pa m2 s-2]. + ! the pressure anomaly at the top of the layer [R L4 T-4 ~> Pa m2 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - dp, & ! The (positive) change in pressure across a layer [R L2 Z-2 ~> Pa]. + dp, & ! The (positive) change in pressure across a layer [R L2 T-2 ~> Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. @@ -137,7 +137,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [R L2 T-2 ~> Pa]. - real :: I_gEarth ! The inverse of GV%g_Earth [L2 Z L-2 ~> s2 m-1] + real :: I_gEarth ! The inverse of GV%g_Earth [T2 Z L-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref [R-1 ~> m3 kg-1]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -148,8 +148,10 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ real :: alpha_ref ! A reference specific volume [R-1 ~> m3 kg-1] that is used ! to reduce the impact of truncation errors. real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. - real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H) [H T2 R-1 L-2 ~> H Pa-1]. - real :: H_to_RL2_T2 ! A factor to convert from thicknesss units (H) to pressure units [R L2 T-2 H-1 ~> Pa H-1]. + real :: Pa_to_H ! A factor to convert from Pa to the thickness units (H) + ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1]. + real :: H_to_RL2_T2 ! A factor to convert from thickness units (H) to pressure + ! units [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]. ! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index e832f72158..27aaf49276 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -365,7 +365,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, 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]. + !! (equal to -dM/dy) [L T-2 ~> m s-2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. @@ -377,7 +377,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, 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]. + ! corrected e times (G_Earth/Rho0) [L2 Z-1 T-2 ~> m s-2]. 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 @@ -629,7 +629,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) 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 the top of a layer [R ~> kg m-3]. real :: G_Rho0 ! A scaled version of g_Earth / Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] - real :: Rho0xG ! g_Earth * Rho0 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] + real :: Rho0xG ! g_Earth * Rho0 [R L2 Z-1 T-2 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. real :: z_neglect ! A thickness that is so small it is usually lost diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 131b7f705d..219d22cc93 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -447,10 +447,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass !! fluxes averaged through the barotropic steps - !! [H L2 T-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps - !! [H L2 T-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(barotropic_CS), pointer :: CS !< The control structure returned by a !! previous call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: visc_rem_u !< Both the fraction of the momentum @@ -623,7 +623,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vhbt_prev, vhbt_sum_prev, & ! Previous transports stored for OBCs [L2 H T-1 ~> m3 s-1] vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m] vhbt_int_prev ! Previous value of time-integrated transport stored for OBCs [L2 H ~> m3] - real :: mass_to_Z ! The depth unit conversion divided by the mean density (Rho0) [Z m-1 R-1 ~> m3 kg-1]. + real :: mass_to_Z ! The depth unit conversion divided by the mean density (Rho0) [Z m-1 R-1 ~> m3 kg-1] !### R-1 real :: mass_accel_to_Z ! The inverse of the mean density (Rho0) [R-1 ~> m3 kg-1]. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. @@ -773,7 +773,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, bebt = CS%bebt be_proj = CS%bebt mass_accel_to_Z = 1.0 / GV%Rho0 - mass_to_Z = US%m_to_Z / GV%Rho0 + mass_to_Z = US%m_to_Z / GV%Rho0 !### THis should be the same as mass_accel_to_Z. !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -3566,7 +3566,7 @@ function find_duhbt_du(u, BTC) result(duhbt_du) !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real :: duhbt_du !< The zonal barotropic face area [L H ~> m2] + real :: duhbt_du !< The zonal barotropic face area [L H ~> m2 or kg m-1] if (u == 0.0) then duhbt_du = 0.5*(BTC%FA_u_E0 + BTC%FA_u_W0) ! Note the potential discontinuity here. @@ -3701,7 +3701,7 @@ function find_dvhbt_dv(v, BTC) result(dvhbt_dv) !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. The dimensions of some !! of the elements in this type vary depending on INTEGRAL_BT_CONT. - real :: dvhbt_dv !< The meridional barotropic face area [L H ~> m2] + real :: dvhbt_dv !< The meridional barotropic face area [L H ~> m2 or kg m-1] if (v == 0.0) then dvhbt_dv = 0.5*(BTC%FA_v_N0 + BTC%FA_v_S0) ! Note the potential discontinuity here. diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d30e1af0f2..a9cd01a6df 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -253,7 +253,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & 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]. + real :: FA_u ! A sum of zonal face areas [H L ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step [T-1 ~> s-1]. @@ -747,7 +747,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(GV)) :: & - uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. + uh_aux, & ! An auxiliary zonal volume flux [H L2 T-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)) :: & uh_err, & ! Difference between uhbt and the summed uh [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -1026,7 +1026,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & 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] + !! faces = v*h*dx [H L2 s-1 ~> m3 s-1 or kg s-1] real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G @@ -1061,7 +1061,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & visc_rem_max ! The column maximum of visc_rem. 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 :: FA_v ! A sum of meridional face areas [H L ~> m2 or kg m-1]. 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. @@ -1557,8 +1557,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables 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]. + vh_aux, & ! An auxiliary meridional volume flux [H L2 T-1 ~> m3 s-1 or kg s-1]. + dvhdv ! Partial derivative of vh with v [H L ~> m2 or kg m-1]. real, dimension(SZI_(G)) :: & vh_err, & ! Difference between vhbt and the summed vh [H L2 T-1 ~> m3 s-1 or kg s-1]. vh_err_best, & ! The smallest value of vh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -1715,7 +1715,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) vh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. + FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and vhtot_R ! and northerly (vhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: FA_0 ! The effective face area with 0 barotropic transport [H L ~> m2 or kg m-1]. diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 04e151d5a7..c4791de53c 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -371,7 +371,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real, dimension(SZI_(HI),SZJ_(HI)), & optional, intent(inout) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer [R L2 Z T-2 ~> Pa Z] + !! top of the layer [R L2 Z T-2 ~> Pa m] real, dimension(SZIB_(HI),SZJ_(HI)), & optional, intent(inout) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f9d70d65d7..cee024dff0 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -312,11 +312,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! 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]. - real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out - real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out - ! uhbt_out and vhbt_out are the vertically summed transports from the - ! barotropic solver based on its final velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJ_(G)) :: eta_pred ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index a67d440dfe..dced9537d9 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -937,7 +937,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real, dimension(SZI_(G)) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netEvap ! net FW flux leaving ocean via evaporation ! [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] + real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 46fbd55862..2b597e355f 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -54,17 +54,26 @@ module MOM_verticalGrid !! as parts of a homogeneous region. integer :: nk_rho_varies = 0 !< The number of layers at the top where the !! density does not track any target density. - real :: H_to_kg_m2 !< A constant that translates thicknesses from the units of thickness to kg m-2. - real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to the units of thickness. - real :: m_to_H !< A constant that translates distances in m to the units of thickness. - real :: H_to_m !< A constant that translates distances in the units of thickness to m. - real :: H_to_Pa !< A constant that translates the units of thickness to pressure [Pa]. - real :: H_to_Z !< A constant that translates thickness units to the units of depth. - real :: Z_to_H !< A constant that translates depth units to thickness units. - real :: H_to_RZ !< A constant that translates thickness units to the units of mass per unit area. - real :: RZ_to_H !< A constant that translates mass per unit area units to thickness units. - real :: H_to_MKS !< A constant that translates thickness units to its - !! MKS unit (m or kg m-2) based on GV%Boussinesq + real :: H_to_kg_m2 !< A constant that translates thicknesses from the units of thickness + !! to kg m-2 [kg m-2 H-1 ~> kg m-3 or 1]. + real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to the units + !! of thickness [H m2 kg-1 ~> m3 kg-1 or 1]. + real :: m_to_H !< A constant that translates distances in m to the units of + !! thickness [H m-1 ~> 1 or kg m-3]. + real :: H_to_m !< A constant that translates distances in the units of thickness + !! to m [m H-1 ~> 1 or m3 kg-1]. + real :: H_to_Pa !< A constant that translates the units of thickness to pressure + !! [Pa H-1 = kg m-1 s-2 H-1 ~> kg m-2 s-2 or m s-2]. + real :: H_to_Z !< A constant that translates thickness units to the units of + !! depth [Z H-1 ~> 1 or m3 kg-1]. + real :: Z_to_H !< A constant that translates depth units to thickness units + !! depth [H Z-1 ~> 1 or kg m-3]. + real :: H_to_RZ !< A constant that translates thickness units to the units of + !! mass per unit area [R Z H-1 ~> kg m-3 or 1]. + real :: RZ_to_H !< A constant that translates mass per unit area units to + !! thickness units [H R-1 Z-1 ~> m3 kg-2 or 1]. + real :: H_to_MKS !< A constant that translates thickness units to its MKS unit + !! (m or kg m-2) based on GV%Boussinesq [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files. end type verticalGrid_type diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index b5a1a6bf0c..9cbb1e4af0 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -54,9 +54,6 @@ module MOM_PointAccel S => NULL(), & !< Salinity [ppt]. u_accel_bt => NULL(), & !< Barotropic u-acclerations [L T-2 ~> m s-2] v_accel_bt => NULL() !< Barotropic v-acclerations [L T-2 ~> m s-2] - real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic - !! pressure anomaly in each layer due to free surface height anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. end type PointAccel_CS contains @@ -85,7 +82,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp 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_(GV)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. 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]. @@ -219,7 +216,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*US%Z_to_m*dt; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*US%Z_to_m*dt_in_T; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -418,7 +415,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp 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_(GV)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. 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]. @@ -556,7 +553,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*US%Z_to_m*dt; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*US%Z_to_m*dt_in_T; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -742,8 +739,8 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) !! directory paths. type(PointAccel_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. -! 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_PointAccel" ! This module's name. if (associated(CS)) return @@ -751,7 +748,7 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%diag => diag ; CS%Time => Time - CS%T => MIS%T ; CS%S => MIS%S ; CS%pbce => MIS%pbce + CS%T => MIS%T ; CS%S => MIS%S CS%u_accel_bt => MIS%u_accel_bt ; CS%v_accel_bt => MIS%v_accel_bt CS%u_prev => MIS%u_prev ; CS%v_prev => MIS%v_prev CS%u_av => MIS%u_av; if (.not.associated(MIS%u_av)) CS%u_av => MIS%u(:,:,:) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index cf6fef06b6..7817fc4959 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -78,13 +78,13 @@ module MOM_diagnostics real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density !! coordinates [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: uh_Rlay => NULL() !< Zonal transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: vh_Rlay => NULL() !< Meridional transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: uhGM_Rlay => NULL() !< Zonal Gent-McWilliams transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: vhGM_Rlay => NULL() !< Meridional Gent-McWilliams transports in potential density - !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] ! following fields are 2-D. real, pointer, dimension(:,:) :: & @@ -1509,7 +1509,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy 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]. + ! [H T-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]. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 5f144af4d5..602041372b 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -54,7 +54,7 @@ module MOM_sum_output integer :: listsize !< length of the list <= niglobal*njglobal + 1 real, allocatable, dimension(:) :: depth !< A list of depths [Z ~> m] real, allocatable, dimension(:) :: area !< The cross-sectional area of the ocean at that depth [L2 ~> m2] - real, allocatable, dimension(:) :: vol_below !< The ocean volume below that depth [Z m2 ~> m3] + real, allocatable, dimension(:) :: vol_below !< The ocean volume below that depth [Z L2 ~> m3] end type Depth_List !> The control structure for the MOM_sum_output module diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index a468f36658..833e7d8165 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -103,9 +103,9 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] real :: det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 - real :: lam ! The eigenvalue [T2 L-2 ~> s m-1] - real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s m-1] - real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s m-1] + real :: lam ! The eigenvalue [T2 L-2 ~> s2 m-2] + real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] + real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s2 m-2] real :: min_h_frac ! [nondim] real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] real, dimension(SZI_(G)) :: & @@ -675,7 +675,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real :: det, ddet ! determinant & its derivative of eigen system real :: lam_1 ! approximate mode-1 eigenvalue [T2 L-2 ~> s2 m-2] real :: lam_n ! approximate mode-n eigenvalue [T2 L-2 ~> s2 m-2] - real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s m-1] + real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] real :: lamMin ! minimum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamMax ! maximum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamInc ! width of moving window for root searching [T2 L-2 ~> s2 m-2] diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 678c48bd03..cf4c518889 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -112,7 +112,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo 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] + pres, & !< Interface pressure [R L2 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]. diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 23f22d8a24..e1b7b200d2 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -709,7 +709,7 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star real, dimension(:), intent(inout) :: drho_dT !< The partial derivative of density with potential !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 ppt-1] or [R degC-1 ~> kg m-3 ppt-1] + !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -754,7 +754,7 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do real, dimension(:), intent(inout) :: drho_dT !< The partial derivative of density with potential !! temperature [R degC-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity - !! [R degC-1 ~> kg m-3 ppt-1] + !! [R ppt-1 ~> kg m-3 ppt-1] type(EOS_type), pointer :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 76d8f64ff1..5ab2874175 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -357,7 +357,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer [R L2 Z T-2 ~> Pa Z] or [Pa Z]. + !! at the top of the layer [R L2 Z T-2 ~> Pa m] or [Pa m]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -549,7 +549,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & real :: dp, dpL, dpR ! Layer pressure thicknesses [R L2 T-2 ~> Pa] or [Pa]. real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] or [Pa]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [R L2 T-2 ~> Pa] or [Pa]. - real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-2 ~> Pa-2] or [Pa-2]. + real :: iDenom ! The inverse of the denominator in the weights [T4 R-2 L-4 ~> Pa-2] or [Pa-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index cfe75ba380..afcad4fb06 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -250,10 +250,10 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) exch_vel_s !< Sub-shelf salt exchange velocity [Z T-1 ~> m s-1] real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & - mass_flux !< Total mass flux of freshwater across the ice-ocean interface. [R Z L2 T-1 ~> kg/s] + mass_flux !< Total mass flux of freshwater across the ice-ocean interface. [R Z L2 T-1 ~> kg s-1] real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & haline_driving !< (SSS - S_boundary) ice-ocean - !! interface, positive for melting and negative for freezing. + !! interface, positive for melting and negative for freezing [ppt]. !! This is computed as part of the ISOMIP diagnostics. real, parameter :: VK = 0.40 !< Von Karman's constant - dimensionless real :: ZETA_N = 0.052 !> The fraction of the boundary layer over which the @@ -1159,7 +1159,7 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes) if (bal_frac(i,j) > 0.0) then ! evap is negative, and vprec has units of [R Z T-1 ~> kg m-2 s-1] fluxes%vprec(i,j) = -balancing_flux - fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! [ Q R Z T-1 ~> W /m^2 ] + fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! [Q R Z T-1 ~> W m-2] fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! [kgSalt/kg R Z T-1 ~> kgSalt m-2 s-1] endif enddo ; enddo diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 7c7705ef35..08c50fa09a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -80,7 +80,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, often in [R L4 Z T-1 ~> kg m2 s-1]. real, pointer, dimension(:,:) :: AGlen_visc => NULL() !< Ice-stiffness parameter in Glen's law ice viscosity, - !!often in [R-1/3 L-2/3 Z-1/3 T-1 ~> kg-1/3 m-1/3 s-1]. + !! often in [kg-1/3 m-1/3 s-1]. real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m]. real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries !! [L yr-1 ~> m yr-1] @@ -1378,7 +1378,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, LB, time_step, hmask, h0, h_after integer :: i, j integer :: ish, ieh, jsh, jeh - real :: u_face ! Zonal velocity at a face [L Z-1 ~> m s-1] + real :: u_face ! Zonal velocity at a face [L T-1 ~> m s-1] real :: h_face ! Thickness at a face for transport [Z ~> m] real :: slope_lim ! The value of the slope limiter, in the range of 0 to 2 [nondim] @@ -1461,7 +1461,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, LB, time_step, hmask, h0, h_after integer :: i, j integer :: ish, ieh, jsh, jeh - real :: v_face ! Pseudo-meridional velocity at a face [L Z-1 ~> m s-1] + real :: v_face ! Pseudo-meridional velocity at a face [L T-1 ~> m s-1] real :: h_face ! Thickness at a face for transport [Z ~> m] real :: slope_lim ! The value of the slope limiter, in the range of 0 to 2 [nondim] @@ -1793,7 +1793,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] - real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> m s-1] + real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> nondim] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] real :: dxh, dyh ! Local grid spacing [L ~> m] real :: grav ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 633058afd7..588fa4c75e 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -144,14 +144,14 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h tmp ! Temporary variable for diagnostic computation real, dimension(SZIB_(G),SZJ_(G)) :: & - MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m-2 s-3]. + MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. ! In one place, MEKE_uflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHu, & ! Depth integrated accumulated zonal mass flux [R Z L2 ~> kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at ! u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m-2 s-3]. + MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. ! In one place, MEKE_vflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHv, & ! Depth integrated accumulated meridional mass flux [R Z L2 ~> kg]. diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 2f9bb1f653..6fbdd30d8f 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1412,12 +1412,12 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! Left and right face energy densities [R Z3 T-2 ~> J m-2]. real, dimension(SZIB_(G),SZJ_(G)) :: & - flux_x ! The internal wave energy flux [J T-1 ~> J s-1]. + flux_x ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(SZIB_(G)) :: & cg_p, cg_m, flux1, flux2 !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & - Fdt_m, Fdt_p! Left and right energy fluxes [J] + Fdt_m, Fdt_p! Left and right energy fluxes [R Z3 L2 T-2 ~> J] integer :: i, j, k, ish, ieh, jsh, jeh, a ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh @@ -1442,8 +1442,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx (J) - Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx (J) + Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx [R Z3 L2 T-2 ~> J] + Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J] enddo ; enddo enddo ! a-loop @@ -1487,12 +1487,12 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & - flux_y ! The internal wave energy flux [J T-1 ~> J s-1]. + flux_y ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(SZI_(G)) :: & cg_p, cg_m, flux1, flux2 !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & - Fdt_m, Fdt_p! South and north energy fluxes [J] + Fdt_m, Fdt_p! South and north energy fluxes [R Z3 L2 T-2 ~> J] character(len=160) :: mesg ! The text of an error message integer :: i, j, k, ish, ieh, jsh, jeh, a @@ -1518,8 +1518,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) - Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) + Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx [R Z3 L2 T-2 ~> J] + Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> J] !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 138e932c22..02edda1b51 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -174,7 +174,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & kd_conv, & !< Diffusivity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] kv_conv, & !< Viscosity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] - N2_3d !< Squared buoyancy frequency for diagnostics [N-2 ~> s-2] + N2_3d !< Squared buoyancy frequency for diagnostics [T-2 ~> s-2] integer :: kOBL !< level of OBL extent real :: g_o_rho0 ! Gravitational acceleration divided by density times unit convserion factors ! [Z s-2 R-1 ~> m4 s-2 kg-1] diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 87e5107acd..eed99ceb3f 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -73,7 +73,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) !! call to CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: GoRho ! Gravitational acceleration divided by density [Z T-2 R-1 ~> m4 s-2 kg-2] + real :: GoRho ! Gravitational acceleration divided by density [Z T-2 R-1 ~> m4 s-2 kg-1] real :: pref ! Interface pressures [R L2 T-2 ~> Pa] real :: DU, DV ! Velocity differences [L T-1 ~> m s-1] real :: DZ ! Grid spacing around an interface [Z ~> m] diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 96b1d66374..be2dfefe8c 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -817,8 +817,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. - KE_orig, & ! The total mean kinetic energy in the mixed layer before - ! convection, [H L2 T-2 ~> H m2 s-2]. + KE_orig, & ! The total mean kinetic energy per unit area in the mixed layer before + ! convection, [H L2 T-2 ~> m3 s-2 or kg s-2]. h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. @@ -1300,7 +1300,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! kinetic energy due to convective !! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step [Z m2 T-2 ~> m3 s-2]. + !! mixing over a time step [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The source of turbulent kinetic energy @@ -1520,7 +1520,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step [Z m2 T-2 ~> m3 s-2]. + !! step [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1551,7 +1551,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: dRL ! Work required to mix water from the next layer ! across the mixed layer [L2 T-2 ~> L2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [L2 T2 ~> m2 s-2]. + ! TKE, divided by layer thickness in m [L2 T-2 ~> m2 s-2]. real :: Cpen1 ! A temporary variable [L2 T-2 ~> m2 s-2]. real :: dMKE ! A temporary variable related to the release of mean ! kinetic energy [H Z L2 T-2 ~> m4 s-2 or kg m s-2] @@ -2310,15 +2310,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, 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 :: s1en ! A work variable [H2 L2 kg m-1 T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [R Z L2 T-3 ~> W m-2] real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. - real :: I_ya, b1 ! Nondimensional work variables. + real :: I_ya, b1 ! Nondimensional work variables [nondim] real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables, real :: Ihk0, Ihk1, Ih12 ! all in [H-1 ~> m-1 or m2 kg-1]. real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, real :: dR0, dR21, dRcv ! all in [R ~> kg m-3]. - real :: dRcv_stays, dRcv_det, dRcv_lim + real :: dRcv_stays, dRcv_det, dRcv_lim ! Assorted densities [R ~> kg m-3] real :: Angstrom ! The minumum layer thickness [H ~> m or kg m-2]. real :: h2_to_k1_lim, T_new, S_new, T_max, T_min, S_max, S_min diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 4c822309d0..6739a92cc9 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -390,7 +390,7 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) 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 :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: d1(SZIB_(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]. @@ -438,7 +438,7 @@ subroutine triDiagTS_Eulerian(G, GV, is, ie, js, je, hold, ent, T, S) 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 :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: d1(SZIB_(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]. diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 23a73cb43e..2cca587e9e 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -196,8 +196,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! ensure positive definiteness [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & pres, & ! Interface pressures [R L2 T-2 ~> Pa]. - pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [R L2 T-2 m Z-1 ~> J m-3]. + pres_Z, & ! The hydrostatic interface pressure, which is used to relate + ! the changes in column thickness to the energy that is radiated + ! as gravity waves and unavailable to drive mixing [R L2 T-2 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. N2, & ! An estimate of the buoyancy frequency [T-2 ~> s-2]. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the @@ -1011,7 +1012,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [R Z L2 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing [R L2 T-2 m Z-1 ~> J m-3]. + !! as gravity waves and unavailable to drive mixing [R L2 T-2 ~> J m-3]. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes @@ -1193,12 +1194,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> 1 or m3 kg-1]. - real :: dT_k, dT_km1 ! Temporary arrays [degC]. - real :: dS_k, dS_km1 ! Temporary arrays [ppt]. - real :: I_Kr_denom ! Temporary arrays [H-2 ~> m-2 or m4 kg-2]. - real :: dKr_dKd ! Nondimensional temporary array [nondim]. - real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays [degC H-1 ~> m-1 or m2 kg-1]. - real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays [ppt H-1 ~> ppt m-1 or ppt m2 kg-1]. + real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] + real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] + real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] + real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2] + real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes + ! per unit change in Kddt_h [degC H-1 ~> degC m-1 or degC m2 kg-1] + real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes + ! per unit change in Kddt_h [ppt H-1 ~> ppt m-1 or ppt m2 kg-1] b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index f7d3a361c6..946a40d39e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -276,7 +276,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to energetic_PBL_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -621,7 +621,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. real :: dt_h ! The timestep divided by the averages of the thicknesses around - ! a layer, times a thickness conversion factor [H T m-2 ~> s m-1 or kg s m-4]. + ! a layer, times a thickness conversion factor [H T Z-2 ~> s m-1 or kg s m-4]. real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. real :: h_rsum ! The running sum of h from the top [Z ~> m]. real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. @@ -1642,13 +1642,15 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: b1Kd ! Temporary array [nondim] real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. - real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> 1 or m3 kg-2]. - real :: dT_k, dT_km1 ! Temporary arrays [degC]. - real :: dS_k, dS_km1 ! Temporary arrays [ppt]. + real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> 1 or m3 kg-1]. + real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] + real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] - real :: dKr_dKd ! Nondimensional temporary array. - real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays [degC H-1 ~> m-1 or m2 kg-1]. - real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays [ppt H-1 ~> ppt m-1 or ppt m2 kg-1]. + real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2] + real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes + ! per unit change in Kddt_h [degC H-1 ~> degC m-1 or degC m2 kg-1] + real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes + ! per unit change in Kddt_h [ppt H-1 ~> ppt m-1 or ppt m2 kg-1] b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 32cdce4d2a..4dc08284af 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -170,7 +170,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface [R ~> kg m-3]. real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors - ! [m3 H-2 s-2 T-1 ~> m s-3 or m7 kg-2 s-3]. + ! [Z3 H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -184,7 +184,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: F_cor ! A correction to the amount of F that is used to ! entrain from the layer above [H ~> m or kg m-2]. - real :: Kd_here ! The effective diapycnal diffusivity [H2 s-1 ~> m2 s-1 or kg2 m-4 s-1]. + real :: Kd_here ! The effective diapycnal diffusivity times the timestep [H2 ~> m2 or kg2 m-4]. real :: h_avail ! The thickness that is available for entrainment [H ~> m or kg m-2]. real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. real :: Rho_cor ! The depth-integrated potential density anomaly that diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index aa1dfbf809..8ddd256ac7 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -319,7 +319,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h !! potential density with temperature [R degC-1 ~> kg m-3 degC-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] + !! potential density with salinity [R ppt-1 ~> kg m-3 ppt-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-point to work on. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa]. @@ -328,8 +328,9 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h ! Local variables 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_(GV)) ! tridiagonal solver. + real :: b1(SZI_(G)) ! A tridiagonal solver variable [H-1 ~> m-1 or m2 kg-1] + real :: d1(SZI_(G)) ! A tridiagonal solver variable [nondim] + real :: c1(SZI_(G),SZK_(GV)) ! A tridiagonal solver variable [nondim] 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]. diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 90da24f170..877f9a0497 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -26,7 +26,7 @@ module MOM_geothermal real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is negative) the !! water is heated in place instead of moving upward between !! layers in non-ALE layered mode [R degC-1 ~> kg m-3 degC-1] - real, allocatable, dimension(:,:) :: geo_heat !< The geothermal heat flux [J m-2 T-1 ~> W m-2] + real, allocatable, dimension(:,:) :: geo_heat !< The geothermal heat flux [Q R Z T-1 ~> W m-2] real :: geothermal_thick !< The thickness over which geothermal heating is !! applied [H ~> m or kg m-2] logical :: apply_geothermal !< If true, geothermal heating will be applied. This is false if diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7f2671399a..b1a4d1433d 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1159,9 +1159,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the ! integrated thickness in the BBL [Z ~> m]. - rho_htot, & ! running integral with depth of density [Z R ~> kg m-2] + rho_htot, & ! running integral with depth of density [R Z ~> kg m-2] gh_sum_top, & ! BBL value of g'h that can be supported by - ! the local ustar, times R0_g [R ~> kg m-2] + ! the local ustar, times R0_g [R Z ~> kg m-2] Rho_top, & ! density at top of the BBL [R ~> kg m-3] TKE, & ! turbulent kinetic energy available to drive ! bottom-boundary layer mixing in a layer [Z3 T-3 ~> m3 s-3] @@ -1174,7 +1174,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar_h ! value of ustar at a thickness point [Z T-1 ~> m s-1]. real :: absf ! average absolute Coriolis parameter around a thickness point [T-1 ~> s-1] - real :: R0_g ! Rho0 / G_Earth [R T2 Z-1 m-1 ~> kg s2 m-5] + real :: R0_g ! Rho0 / G_Earth [R T2 Z-1 ~> kg s2 m-4] real :: I_rho0 ! 1 / RHO0 [R-1 ~> m3 kg-1] real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 T-1 ~> m2 s-1]. logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities @@ -1395,7 +1395,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int real :: Kd_wall ! Law of the wall diffusivity [Z2 T-1 ~> m2 s-1]. real :: Kd_lower ! diffusivity for lower interface [Z2 T-1 ~> m2 s-1] real :: ustar_D ! u* x D [Z2 T-1 ~> m2 s-1]. - real :: I_Rho0 ! 1 / rho0 [R-1 ~> m3 kg-1] + real :: I_Rho0 ! 1 / rho0 [R-1 ~> m3 kg-1] real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall [T-2 ~> s-2] logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on ! the assumption that this extracted energy also drives diapycnal mixing. @@ -1438,7 +1438,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int ! (Note that visc%TKE_BBL is in [Z3 T-3 ~> m3 s-3], set in set_BBL_TKE().) ! I am still unsure about sqrt(cdrag) in this expressions - AJA TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j) - ! Add in tidal dissipation energy at the bottom [R Z3 T-3 ~> m3 s-3]. + ! Add in tidal dissipation energy at the bottom [Z3 T-3 ~> m3 s-3]. ! Note that TKE_tidal is in [R Z3 T-3 ~> W m-2]. if (associated(fluxes%TKE_tidal)) & TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index dc6a121df1..ef27146a18 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -156,13 +156,13 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) ! Local variables 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(SZIB_(G),SZJ_(G),SZK_(GV)) :: uFlx !< Zonal flux of tracer [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vFlx !< Meridional flux of tracer - !! [conc H L2 ~> conc kg or conc m^3] + !! [conc H L2 ~> conc m3 or conc kg] real, dimension(SZIB_(G),SZJ_(G)) :: uwork_2d !< Layer summed u-flux transport - !! [conc H L2 ~> conc kg or conc m^3] + !! [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G),SZJB_(G)) :: vwork_2d !< Layer summed v-flux transport - !! [conc H L2 ~> conc kg or conc m^3] + !! [conc H L2 ~> conc m3 or conc kg] 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 diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 4851bec9c1..05909cb8fc 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -305,14 +305,15 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth [H ~> m or kg m-2] integer :: iMethod real, dimension(SZI_(G)) :: ref_pres ! Reference pressure used to calculate alpha/beta [R L2 T-2 ~> Pa] - real, dimension(SZI_(G)) :: rho_tmp ! Routine to calculate drho_dp, returns density which is not used + real, dimension(SZI_(G)) :: rho_tmp ! Routine to calculate drho_dp, returns density which is not used [R ~> kg m-3] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] integer, dimension(SZI_(G), SZJ_(G)) :: k_top ! Index of the first layer within the boundary real, dimension(SZI_(G), SZJ_(G)) :: zeta_top ! Distance from the top of a layer to the intersection of the ! top extent of the boundary layer (0 at top, 1 at bottom) [nondim] integer, dimension(SZI_(G), SZJ_(G)) :: k_bot ! Index of the last layer within the boundary - real, dimension(SZI_(G), SZJ_(G)) :: zeta_bot ! Distance of the lower layer to the boundary layer depth - real :: pa_to_H ! A conversion factor from pressure to H units [H T2 R-1 Z-2 ~> m Pa-1 or s2 m-2] + real, dimension(SZI_(G), SZJ_(G)) :: zeta_bot ! Distance of the lower layer to the boundary layer depth [nondim] + real :: pa_to_H ! A conversion factor from rescaled pressure to thickness + ! (H) units [H T2 R-1 Z-2 ~> m Pa-1 or s2 m-1] pa_to_H = 1. / (GV%H_to_RZ * GV%g_Earth) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index a3c9965a11..be4c059982 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -364,7 +364,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZIB_(G),SZJ_(G),ntr) :: & flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real, dimension(SZI_(G),ntr) :: & - T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. + T_tmp ! The copy of the tracer concentration at constant i,k [conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. @@ -727,9 +727,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, dimension(SZI_(G),ntr,SZJ_(G)) :: & slope_y ! The concentration slope per grid point [conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_y ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. + T_tmp ! The copy of the tracer concentration at constant i,k [conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index bb12d316cb..209fc8c5db 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -82,9 +82,9 @@ module MOM_tracer_registry 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] ! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] +! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] ! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! expressed as a change in concentration [conc s-1] +! !! expressed as a change in concentration [conc T-1] real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous !! timestep used for diagnostics [conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 6d355db36f..274f85d435 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -184,7 +184,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. 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]. + ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB integer :: nzdata diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 0085e67212..a26bca4711 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -434,7 +434,7 @@ subroutine query_wave_properties(CS, NumBands, WaveNumbers, US) integer, optional, intent(out) :: NumBands !< If present, this returns the number of !!< wavenumber partitions in the wave discretization real, dimension(:), optional, intent(out) :: Wavenumbers !< If present this returns the characteristic - !! wavenumbers of the wave discretization [m-1 or Z-1 ~> m-1] + !! wavenumbers of the wave discretization [m-1] or [Z-1 ~> m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type that is used to undo !! the dimensional scaling of the output variables, if present integer :: n diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 261a01ab03..1fbc7a2b62 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -69,8 +69,8 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) [ppt] real :: LowerLayerTemp !< Temp at top of lower layer [degC] real :: LowerLayerSalt !< Salt at top of lower layer [ppt] - real :: LowerLayerdTdz !< Temp gradient in lower layer [degC / Z ~> degC m-1]. - real :: LowerLayerdSdz !< Salt gradient in lower layer [ppt / Z ~> ppt m-1]. + real :: LowerLayerdTdz !< Temp gradient in lower layer [degC Z-1 ~> degC m-1]. + real :: LowerLayerdSdz !< Salt gradient in lower layer [ppt Z-1 ~> ppt m-1]. real :: LowerLayerMinTemp !< Minimum temperature in lower layer [degC] real :: zC, DZ, top, bottom ! Depths and thicknesses [Z ~> m]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz From ca61bf94763e2a7b3bfa6f195b67ca6d2e83d230 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 24 Sep 2021 17:10:01 -0400 Subject: [PATCH 033/138] Horizontal viscosity pointer removal * Change `hor_visc_CS` pointers to locals --- src/core/MOM_dynamics_split_RK2.F90 | 10 ++-- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +- .../lateral/MOM_hor_visc.F90 | 55 ++++++------------- 4 files changed, 29 insertions(+), 48 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index cee024dff0..c045ce24c1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -199,7 +199,7 @@ module MOM_dynamics_split_RK2 ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure @@ -724,7 +724,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & + MEKE, Varmix, G, GV, US, CS%hor_visc, & OBC=CS%OBC, BT=CS%barotropic_CSp, TD=thickness_diffuse_CSp, & ADp=CS%ADp) call cpu_clock_end(id_clock_horvisc) @@ -1394,7 +1394,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE, ADp=CS%ADp) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & @@ -1438,7 +1438,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) then call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, US, CS%hor_visc_CSp, & + G, GV, US, CS%hor_visc, & OBC=CS%OBC, BT=CS%barotropic_CSp, & TD=thickness_diffuse_CSp) else @@ -1696,7 +1696,7 @@ subroutine end_dyn_split_RK2(CS) call vertvisc_end(CS%vertvisc_CSp) deallocate(CS%vertvisc_CSp) - call hor_visc_end(CS%hor_visc_CSp) + call hor_visc_end(CS%hor_visc) call PressureForce_end(CS%PressureForce_CSp) deallocate(CS%PressureForce_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 48d767e1a8..c751c19921 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -144,7 +144,7 @@ module MOM_dynamics_unsplit ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure @@ -258,7 +258,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! diffu = horizontal viscosity terms (u,h) call enable_averages(dt, Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, G, GV, US, CS%hor_visc_CSp) + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, G, GV, US, CS%hor_visc) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -658,7 +658,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e6fec7f61e..563e9723da 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -146,7 +146,7 @@ module MOM_dynamics_unsplit_RK2 ! The remainder of the structure points to child subroutines' control structures. !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure @@ -269,7 +269,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call enable_averages(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, US, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) @@ -620,7 +620,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc_CSp, MEKE) + call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index db2514576d..0b733514a7 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -177,8 +177,8 @@ module MOM_hor_visc type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics - ! real, pointer :: hf_diffu(:,:,:) => NULL() ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, pointer :: hf_diffv(:,:,:) => NULL() ! Merdional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffu(:,:,:) ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffv(:,:,:) ! Merdional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. ! 3D diagnostics hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. ! The code is retained for degugging purposes in the future. @@ -238,14 +238,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(hor_visc_CS), pointer :: CS !< Control structure returned by a previous - !! call to hor_visc_init. + type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control struct type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type - type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing - !! barotropic velocities. - type(thickness_diffuse_CS), optional, pointer :: TD !< Pointer to a structure containing - !! thickness diffusivities. - type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers + type(barotropic_CS), intent(in), optional :: BT !< Barotropic control struct + type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control struct + type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -419,8 +416,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, apply_OBC = .true. endif ; endif ; endif - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_hor_visc: Module must be initialized before it is used.") if (.not.(CS%Laplacian .or. CS%biharmonic)) return find_FrictWork = (CS%id_FrictWork > 0) @@ -1457,11 +1452,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo ! Applying GME diagonal term. This is linear and the arguments can be rescaled. - !### This smoothing is only applied at computational grid points, but is used in extra halo points! - !### There are blocking halo updates in the smooth_GME routines, which could be avoided by expanding - ! the loop ranges by a point in the code setting str_xx_GME and str_xy_GME a few lines above. - call smooth_GME(CS, G, GME_flux_h=str_xx_GME) - call smooth_GME(CS, G, GME_flux_q=str_xy_GME) + call smooth_GME(G, GME_flux_h=str_xx_GME) + call smooth_GME(G, GME_flux_q=str_xy_GME) do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) @@ -1756,13 +1748,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call post_data(CS%id_diffv_visc_rem, diffv_visc_rem, CS%diag) deallocate(diffv_visc_rem) endif - end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). !! hor_visc_init calculates and stores the values of a number of metric functions that !! are used in horizontal_viscosity(). -subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) +subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) type(time_type), intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -1770,10 +1761,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. - type(hor_visc_CS), pointer :: CS !< Pointer to the control structure for this module - type(MEKE_type), pointer :: MEKE !< MEKE data - type(accel_diag_ptrs), optional, pointer :: ADp !< Acceleration diagnostic pointers - ! Local variables + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct + type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics + real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! u0v is the Laplacian sensitivities to the v velocities @@ -1830,12 +1820,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "hor_visc_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) + CS%diag => diag ! Read parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -2455,7 +2440,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) ! 'Fractional Thickness-weighted Zonal Acceleration from Horizontal Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if ((CS%id_hf_diffu > 0) .and. (present(ADp))) then - ! call safe_alloc_ptr(CS%hf_diffu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) + ! call safe_alloc_alloc(CS%hf_diffu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) ! call safe_alloc_ptr(ADp%diag_hfrac_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) !endif @@ -2463,7 +2448,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) ! 'Fractional Thickness-weighted Meridional Acceleration from Horizontal Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if ((CS%id_hf_diffv > 0) .and. (present(ADp))) then - ! call safe_alloc_ptr(CS%hf_diffv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) + ! call safe_alloc_alloc(CS%hf_diffv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) ! call safe_alloc_ptr(ADp%diag_hfrac_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) !endif @@ -2587,7 +2572,7 @@ end subroutine hor_visc_init !> Calculates factors in the anisotropic orientation tensor to be align with the grid. !! With n1=1 and n2=0, this recovers the approach of Large et al, 2001. subroutine align_aniso_tensor_to_grid(CS, n1, n2) - type(hor_visc_CS), pointer :: CS !< Control structure for horizontal viscosity + type(hor_visc_CS), intent(inout) :: CS !< Control structure for horizontal viscosity real, intent(in) :: n1 !< i-component of direction vector [nondim] real, intent(in) :: n2 !< j-component of direction vector [nondim] ! Local variables @@ -2603,9 +2588,7 @@ end subroutine align_aniso_tensor_to_grid !> Apply a 1-1-4-1-1 Laplacian filter one time on GME diffusive flux to reduce any !! horizontal two-grid-point noise -subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) - ! Arguments - type(hor_visc_CS), pointer :: CS !< Control structure +subroutine smooth_GME(G, GME_flux_h, GME_flux_q) type(ocean_grid_type), intent(in) :: G !< Ocean grid real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< GME diffusive flux !! at h points @@ -2672,8 +2655,7 @@ end subroutine smooth_GME !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) - type(hor_visc_CS), pointer :: CS !< The control structure returned by a - !! previous call to hor_visc_init. + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct if (CS%Laplacian .or. CS%biharmonic) then DEALLOC_(CS%dx2h) ; DEALLOC_(CS%dx2q) ; DEALLOC_(CS%dy2h) ; DEALLOC_(CS%dy2q) DEALLOC_(CS%dx_dyT) ; DEALLOC_(CS%dy_dxT) ; DEALLOC_(CS%dx_dyBu) ; DEALLOC_(CS%dy_dxBu) @@ -2716,7 +2698,6 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%n1n1_m_n2n2_h) DEALLOC_(CS%n1n1_m_n2n2_q) endif - deallocate(CS) end subroutine hor_visc_end !> \namespace mom_hor_visc !! From 0e1910327aaad006ec31abae02278b72aec7f09f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 30 Sep 2021 16:57:35 -0400 Subject: [PATCH 034/138] MEKE pointer cleanup * equilibrium_value removed from CS and is now local * MEKE_CS function arguments to stack --- src/core/MOM.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 46 ++++++++++------------ 2 files changed, 21 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 112613dc88..1fe748834d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -356,7 +356,7 @@ module MOM !< Pointer to the control structure used to set viscosities type(diabatic_CS), pointer :: diabatic_CSp => NULL() !< Pointer to the control structure for the diabatic driver - type(MEKE_CS), pointer :: MEKE_CSp => NULL() + type(MEKE_CS) :: MEKE_CSp !< Pointer to the control structure for the MEKE updates type(VarMix_CS), pointer :: VarMix => NULL() !< Pointer to the control structure for the variable mixing module @@ -3626,8 +3626,6 @@ subroutine MOM_end(CS) if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) - if (associated(CS%MEKE_CSp)) deallocate(CS%MEKE_CSp) - if (associated(CS%MEKE)) then call MEKE_end(CS%MEKE) deallocate(CS%MEKE) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 588fa4c75e..5b58280277 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -30,8 +30,6 @@ module MOM_MEKE !> Control structure that contains MEKE parameters and diagnostics handles type, public :: MEKE_CS ; private ! Parameters - real, dimension(:,:), pointer :: equilibrium_value => NULL() !< The equilbrium value - !! of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2] real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE [nondim] real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE [nondim] real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] @@ -123,7 +121,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] @@ -141,7 +139,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2, & ! Ratio of EKE_bottom / EKE [nondim] - tmp ! Temporary variable for diagnostic computation + tmp, & ! Temporary variable for diagnostic computation + equilibrium_value ! The equilbrium value of MEKE to be calculated at each + ! time step [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G)) :: & MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. @@ -175,8 +175,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_MEKE: Module must be initialized before it is used.") if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") @@ -355,9 +353,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif if (CS%MEKE_equilibrium_restoring) then - call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) + call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & + equilibrium_value) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - CS%equilibrium_value(i,j)) + src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - equilibrium_value(i,j)) enddo ; enddo endif @@ -674,7 +673,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. @@ -835,13 +834,16 @@ end subroutine MEKE_equilibrium !< This subroutine calculates a new equilibrium value for MEKE at each time step. This is not copied into !! MEKE%MEKE; rather, it is used as a restoring term to nudge MEKE%MEKE back to an equilibrium value -subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) +subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & + equilibrium_value) type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type. - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: equilibrium_value + !< Equilbrium value of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2] ! Local variables real :: SN ! The local Eady growth rate [T-1 ~> s-1] @@ -850,20 +852,17 @@ subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec cd2 = CS%cdrag**2 - - if (.not. associated(CS%equilibrium_value)) allocate(CS%equilibrium_value(SZI_(G),SZJ_(G))) - CS%equilibrium_value(:,:) = 0.0 + equilibrium_value(:,:) = 0.0 !$OMP do do j=js,je ; do i=is,ie ! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) - CS%equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 + equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 enddo ; enddo - if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, CS%equilibrium_value, CS%diag) - + if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, equilibrium_value, CS%diag) end subroutine MEKE_equilibrium_restoring !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ @@ -871,8 +870,8 @@ end subroutine MEKE_equilibrium_restoring !! column eddy energy, respectively. See \ref section_MEKE_equations. subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & bottomFac2, barotrFac2, LmixScale) - type(MEKE_CS), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE data. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. + type(MEKE_type), intent(in) :: MEKE !< MEKE data. type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -946,7 +945,7 @@ end subroutine MEKE_lengthScales !! column eddy energy, respectively. See \ref section_MEKE_equations. subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(in) :: CS !< MEKE control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: area !< Grid cell area [L2 ~> m2] real, intent(in) :: beta !< Planetary beta = \f$ \nabla f\f$ [T-1 L-1 ~> s-1 m-1] @@ -1023,7 +1022,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. - type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE-related fields. type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. @@ -1058,11 +1057,6 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "MEKE-type structure.") return endif - if (associated(CS)) then - call MOM_error(WARNING, & - "MEKE_init called with an associated control structure.") - return - else ; allocate(CS) ; endif call MOM_mesg("MEKE_init: reading parameters ", 5) From 899bf4ee93693b918822ff298ea9dd2e5f1854e5 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 5 Oct 2021 12:31:37 -0400 Subject: [PATCH 035/138] Mixed layer pointer purge * `mixedlayer_restrat_CS` pointers changed to locals MLD_filtered[_slow] pointed moved to allocatables * MLD argument for `mixedlayer_restrat` Restore MLD pointer Passing an uninitialized array is problematic, though passing a pointer to an uninitialized array is not. This can be addressed when vertvisc_type is resolved. --- src/core/MOM.F90 | 5 +-- .../lateral/MOM_mixed_layer_restrat.F90 | 34 +++++-------------- 2 files changed, 10 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1fe748834d..edaab389bc 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -350,7 +350,7 @@ module MOM type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() !< Pointer to the control structure used for the isopycnal height diffusive transport. !! This is also common referred to as Gent-McWilliams diffusion - type(mixedlayer_restrat_CS), pointer :: mixedlayer_restrat_CSp => NULL() + type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp !< Pointer to the control structure used for the mixed layer restratification type(set_visc_CS), pointer :: set_visc_CSp => NULL() !< Pointer to the control structure used to set viscosities @@ -3620,9 +3620,6 @@ subroutine MOM_end(CS) deallocate(CS%VarMix) endif - if (associated(CS%mixedlayer_restrat_CSp)) & - deallocate(CS%mixedlayer_restrat_CSp) - if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0d2062441e..7d84120f9c 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -60,9 +60,9 @@ module MOM_mixed_layer_restrat type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - real, dimension(:,:), pointer :: & - MLD_filtered => NULL(), & !< Time-filtered MLD [H ~> m or kg m-2] - MLD_filtered_slow => NULL() !< Slower time-filtered MLD [H ~> m or kg m-2] + real, dimension(:,:), allocatable :: & + MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] + MLD_filtered_slow !< Slower time-filtered MLD [H ~> m or kg m-2] !>@{ !! Diagnostic identifier @@ -102,10 +102,7 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure - - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & - "Module must be initialized before it is used.") + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure if (GV%nkml>0) then call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) @@ -132,7 +129,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -236,8 +233,6 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo enddo ! j-loop elseif (CS%MLE_use_PBL_MLD) then - if (.not. associated(MLD_in)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & - "Argument MLD_in was not associated!") do j = js-1, je+1 ; do i = is-1, ie+1 MLD_fast(i,j) = (CS%MLE_MLD_stretch * GV%Z_to_H) * MLD_in(i,j) enddo ; enddo @@ -571,7 +566,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [T ~> s] - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -614,8 +609,6 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nkml = GV%nkml - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & - "Module must be initialized before it is used.") if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 @@ -800,7 +793,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables @@ -822,10 +815,6 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "BULKMIXEDLAYER is true.", default=.false.) if (.not. mixedlayer_restrat_init) return - if (.not.associated(CS)) then - call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") - endif - ! Nonsense values to cause problems when these parameters are not used CS%MLE_MLD_decay_time = -9.e9*US%s_to_T CS%MLE_density_diff = -9.e9*US%kg_m3_to_R @@ -940,7 +929,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, endif ! If MLD_filtered is being used, we need to update halo regions after a restart - if (associated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) + if (allocated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) end function mixedlayer_restrat_init @@ -949,7 +938,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse - type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables type(vardesc) :: vd @@ -960,11 +949,6 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) default=.false., do_not_log=.true.) if (.not. mixedlayer_restrat_init) return - ! Allocate the control structure. CS will be later populated by mixedlayer_restrat_init() - if (associated(CS)) call MOM_error(FATAL, & - "mixedlayer_restrat_register_restarts called with an associated control structure.") - allocate(CS) - call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & default=0., do_not_log=.true.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & From 9bf87154483d831afee41f744171e74c84198f74 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 5 Oct 2021 15:26:35 -0400 Subject: [PATCH 036/138] Thickness diffusion pointer removal * `thickness_diffusion_CSp` is moved to local where possible * All arrays and most other pointer content is moved to either allocatable or local to the type. --- src/core/MOM.F90 | 3 +- src/core/MOM_dynamics_split_RK2.F90 | 6 +-- src/core/MOM_dynamics_unsplit.F90 | 1 - src/core/MOM_dynamics_unsplit_RK2.F90 | 1 - .../lateral/MOM_thickness_diffuse.F90 | 49 +++++++++---------- 5 files changed, 25 insertions(+), 35 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index edaab389bc..98e94c0592 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -347,7 +347,7 @@ module MOM !< Pointer to the control structure used for the unsplit RK2 dynamics type(MOM_dyn_split_RK2_CS), pointer :: dyn_split_RK2_CSp => NULL() !< Pointer to the control structure used for the mode-split RK2 dynamics - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() + type(thickness_diffuse_CS) :: thickness_diffuse_CSp !< Pointer to the control structure used for the isopycnal height diffusive transport. !! This is also common referred to as Gent-McWilliams diffusion type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp @@ -3613,7 +3613,6 @@ subroutine MOM_end(CS) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) - deallocate(CS%thickness_diffuse_CSp) if (associated(CS%VarMix)) then call VarMix_end(CS%VarMix) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c045ce24c1..42dedf5a2e 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -209,8 +209,6 @@ module MOM_dynamics_split_RK2 !> A pointer to the barotropic stepping control structure type(barotropic_CS), pointer :: barotropic_CSp => NULL() !> A pointer to a structure containing interface height diffusivities - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() - !> A pointer to the vertical viscosity control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure type(set_visc_CS), pointer :: set_visc_CSp => NULL() @@ -292,7 +290,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to a structure containing + type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -1261,7 +1259,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param !! diagnostic pointers type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure + type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index c751c19921..5f525596b5 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -89,7 +89,6 @@ module MOM_dynamics_unsplit use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS -use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 563e9723da..42efec91f9 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -87,7 +87,6 @@ module MOM_dynamics_unsplit_RK2 use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS -use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 78425676b1..c68558a647 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -82,13 +82,12 @@ module MOM_thickness_diffuse !! Negative values disable the scheme." [nondim] type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics - real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] - real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] - real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] + real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] + real, allocatable :: diagSlopeX(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] + real, allocatable :: diagSlopeY(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] - real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] - KH_v_GME => NULL() !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_u_GME(:,:,:) !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: KH_v_GME(:,:,:) !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -119,7 +118,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(MEKE_type), pointer :: MEKE !< MEKE control structure type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G),SZK_(GV)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. @@ -161,9 +160,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& - "Module must be initialized before it is used.") - if ((.not.CS%thickness_diffuse) .or. & .not.( CS%Khth > 0.0 .or. associated(VarMix) .or. associated(MEKE) ) ) return @@ -579,7 +575,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] real, intent(in) :: dt !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of @@ -727,7 +723,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = .false. if (associated(MEKE)) find_work = associated(MEKE%GM_src) - find_work = (associated(CS%GMwork) .or. find_work) + find_work = (allocated(CS%GMwork) .or. find_work) if (use_EOS) then halo = 1 ! Default halo to fill is 1 @@ -1411,7 +1407,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) - if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h + if (allocated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE) .and. .not.CS%GM_src_alt) then ; if (associated(MEKE%GM_src)) then MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h endif ; endif @@ -1487,7 +1483,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration @@ -1893,7 +1889,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation diagnostics - type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1904,12 +1900,6 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! rotation [nondim]. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. - if (associated(CS)) then - call MOM_error(WARNING, & - "Thickness_diffuse_init called with an associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ! Read all relevant parameters and write them to the model log. @@ -2027,8 +2017,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) default=.false.) if (CS%use_GME_thickness_diffuse) then - call safe_alloc_ptr(CS%KH_u_GME,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) - call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) + allocate(CS%KH_u_GME(G%IsdB:G%IedB, G%jsd:G%jed, GV%ke+1), source=0.) + allocate(CS%KH_v_GME(G%isd:G%ied, G%JsdB:G%JedB, GV%ke+1), source=0.) endif CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & @@ -2047,7 +2037,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2, cmor_field_name='tnkebto', & cmor_long_name='Integrated Tendency of Ocean Mesoscale Eddy KE from Parameterized Eddy Advection', & cmor_standard_name='tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection') - if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) + if (CS%id_GMwork > 0) & + allocate(CS%GMwork(G%isd:G%ied,G%jsd:G%jed), source=0.) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & 'Parameterized mesoscale eddy advection diffusivity at U-point', & @@ -2074,10 +2065,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & 'Zonal slope of neutral surface', 'nondim', conversion=US%Z_to_L) - if (CS%id_slope_x > 0) call safe_alloc_ptr(CS%diagSlopeX,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) + if (CS%id_slope_x > 0) & + allocate(CS%diagSlopeX(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke+1), source=0.) + CS%id_slope_y = register_diag_field('ocean_model', 'neutral_slope_y', diag%axesCvi, Time, & 'Meridional slope of neutral surface', 'nondim', conversion=US%Z_to_L) - if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) + if (CS%id_slope_y > 0) & + allocate(CS%diagSlopeY(G%isd:G%ied,G%JsdB:G%JedB,GV%ke+1), source=0.) + CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction', & 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -2095,7 +2090,7 @@ end subroutine thickness_diffuse_init !> Copies ubtav and vbtav from private type into arrays subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G, GV) - type(thickness_diffuse_CS), pointer :: CS !< Control structure for this module + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for this module type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: KH_u_GME !< interface height From c91b464c080cf602c454d1291c656cdc3638d50e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 5 Oct 2021 17:11:05 -0400 Subject: [PATCH 037/138] Tidal forcing CS pointer removal * `tidal_forcing_CS` pointers are removed, and its fields are converted to allocatables. - Note that references are retained in the pressure force and barotropic CS instances, to avoid copies. Still working through that one... --- src/core/MOM_PressureForce.F90 | 2 +- src/core/MOM_PressureForce_FV.F90 | 5 +- src/core/MOM_PressureForce_Montgomery.F90 | 7 +-- src/core/MOM_barotropic.F90 | 6 ++- src/core/MOM_dynamics_split_RK2.F90 | 7 +-- .../lateral/MOM_tidal_forcing.F90 | 52 ++++++++----------- 6 files changed, 35 insertions(+), 44 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index dbc01dcc27..0ac1eb1ae1 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -88,7 +88,7 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_CS), pointer :: CS !< Pressure force control structure - type(tidal_forcing_CS), pointer :: tides_CSp !< Tide control structure + type(tidal_forcing_CS), intent(inout), optional :: tides_CSp !< Tide control structure #include "version_variable.h" character(len=40) :: mdl = "MOM_PressureForce" ! This module's name. diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 3100699e6f..ef5a85697c 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -808,7 +808,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure - type(tidal_forcing_CS), pointer :: tides_CSp !< Tides control structure + type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. @@ -821,7 +821,8 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS else ; allocate(CS) ; endif CS%diag => diag ; CS%Time => Time - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp + if (present(tides_CSp)) & + CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_FV" call log_version(param_file, mdl, version, "") diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 27aaf49276..4b98e0f73f 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -824,8 +824,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure - type(tidal_forcing_CS), pointer :: tides_CSp !< Tides control structure + type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure + type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! Local variables logical :: use_temperature, use_EOS @@ -840,7 +840,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ else ; allocate(CS) ; endif CS%diag => diag ; CS%Time => Time - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp + if (present(tides_CSp)) & + CS%tides_CSp => tides_CSp mdl = "MOM_PressureForce_Mont" call log_version(param_file, mdl, version, "") diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 219d22cc93..cf52bd3a89 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4259,7 +4259,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of !! barotropic flow. - type(tidal_forcing_CS), pointer :: tides_CSp !< A pointer to the control structure of the + type(tidal_forcing_CS), target, optional :: tides_CSp !< A pointer to the control structure of the !! tide module. ! This include declares and sets the variable "version". @@ -4316,7 +4316,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%module_is_initialized = .true. CS%diag => diag ; CS%Time => Time - if (associated(tides_CSp)) CS%tides_CSp => tides_CSp + if (present(tides_CSp)) then + CS%tides_CSp => tides_CSp + endif ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "SPLIT", CS%split, default=.true., do_not_log=.true.) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 42dedf5a2e..14741dbbd1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -213,7 +213,7 @@ module MOM_dynamics_split_RK2 !> A pointer to the set_visc control structure type(set_visc_CS), pointer :: set_visc_CSp => NULL() !> A pointer to the tidal forcing control structure - type(tidal_forcing_CS), pointer :: tides_CSp => NULL() + type(tidal_forcing_CS) :: tides_CSp !> A pointer to the ALE control structure. type(ALE_CS), pointer :: ALE_CSp => NULL() @@ -1699,10 +1699,7 @@ subroutine end_dyn_split_RK2(CS) call PressureForce_end(CS%PressureForce_CSp) deallocate(CS%PressureForce_CSp) - if (associated(CS%tides_CSp)) then - call tidal_forcing_end(CS%tides_CSp) - deallocate(CS%tides_CSp) - endif + call tidal_forcing_end(CS%tides_CSp) call CoriolisAdv_end(CS%CoriolisAdv_Csp) deallocate(CS%CoriolisAdv_CSp) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 0d92a14d2a..b8d5c44098 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -60,15 +60,15 @@ module MOM_tidal_forcing type(time_type) :: time_ref !< Reference time (t = 0) used to calculate tidal forcing. type(astro_longitudes) :: tidal_longitudes !< Astronomical longitudes used to calculate !! tidal phases at t = 0. - real, pointer, dimension(:,:,:) :: & - sin_struct => NULL(), & !< The sine and cosine based structures that can - cos_struct => NULL(), & !< be associated with the astronomical forcing. - cosphasesal => NULL(), & !< The cosine and sine of the phase of the - sinphasesal => NULL(), & !< self-attraction and loading amphidromes. - ampsal => NULL(), & !< The amplitude of the SAL [m]. - cosphase_prev => NULL(), & !< The cosine and sine of the phase of the - sinphase_prev => NULL(), & !< amphidromes in the previous tidal solutions. - amp_prev => NULL() !< The amplitude of the previous tidal solution [m]. + real, allocatable :: & + sin_struct(:,:,:), & !< The sine and cosine based structures that can + cos_struct(:,:,:), & !< be associated with the astronomical forcing. + cosphasesal(:,:,:), & !< The cosine and sine of the phase of the + sinphasesal(:,:,:), & !< self-attraction and loading amphidromes. + ampsal(:,:,:), & !< The amplitude of the SAL [m]. + cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the + sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. + amp_prev(:,:,:) !< The amplitude of the previous tidal solution [m]. end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides @@ -230,8 +230,8 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(tidal_forcing_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & phase, & ! The phase of some tidal constituent. @@ -253,12 +253,6 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "tidal_forcing_init called with an associated "// & - "control structure.") - return - endif - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "TIDES", tides, & @@ -266,8 +260,6 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) if (.not.tides) return - allocate(CS) - ! Set up the spatial structure functions for the diurnal, semidiurnal, and ! low-frequency tidal components. allocate(CS%sin_struct(isd:ied,jsd:jed,3), source=0.0) @@ -560,7 +552,7 @@ end subroutine find_in_files !! and loading. subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to tidal_forcing_init. + type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a previous call to tidal_forcing_init. real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with !! the local value of eta [nondim]. @@ -586,7 +578,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height !! anomalies [Z ~> m]. - type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a + type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. real, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. @@ -599,8 +591,6 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not.associated(CS)) return - call cpu_clock_begin(id_clock_tides) if (CS%nc == 0) then @@ -659,16 +649,16 @@ subroutine tidal_forcing_end(CS) type(tidal_forcing_CS), intent(inout) :: CS !< The control structure returned by a previous call !! to tidal_forcing_init; it is deallocated here. - if (associated(CS%sin_struct)) deallocate(CS%sin_struct) - if (associated(CS%cos_struct)) deallocate(CS%cos_struct) + if (allocated(CS%sin_struct)) deallocate(CS%sin_struct) + if (allocated(CS%cos_struct)) deallocate(CS%cos_struct) - if (associated(CS%cosphasesal)) deallocate(CS%cosphasesal) - if (associated(CS%sinphasesal)) deallocate(CS%sinphasesal) - if (associated(CS%ampsal)) deallocate(CS%ampsal) + if (allocated(CS%cosphasesal)) deallocate(CS%cosphasesal) + if (allocated(CS%sinphasesal)) deallocate(CS%sinphasesal) + if (allocated(CS%ampsal)) deallocate(CS%ampsal) - if (associated(CS%cosphase_prev)) deallocate(CS%cosphase_prev) - if (associated(CS%sinphase_prev)) deallocate(CS%sinphase_prev) - if (associated(CS%amp_prev)) deallocate(CS%amp_prev) + if (allocated(CS%cosphase_prev)) deallocate(CS%cosphase_prev) + if (allocated(CS%sinphase_prev)) deallocate(CS%sinphase_prev) + if (allocated(CS%amp_prev)) deallocate(CS%amp_prev) end subroutine tidal_forcing_end !> \namespace tidal_forcing From 4a98271a272e1ffcbceb32b687fb6a37a3ee5f2c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 6 Oct 2021 16:47:31 -0400 Subject: [PATCH 038/138] Internal tide pointer removal * Internal tide CS pointer removal (int_tide_CS) * Diabatic driver's `int_tide_CSp` renamed to `int_tide` I am unsure if the instance of int_tide_CS in the diabatic driver (where it is created) needs to be declared as target. Seems not, but watch this issue. --- .../lateral/MOM_internal_tides.F90 | 70 ++++++------------- .../vertical/MOM_diabatic_driver.F90 | 8 +-- .../vertical/MOM_set_diffusivity.F90 | 7 +- 3 files changed, 30 insertions(+), 55 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 6fbdd30d8f..fd420a261f 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -107,10 +107,10 @@ module MOM_internal_tides !< If true, apply scattering due to small-scale roughness as a sink. logical :: apply_Froude_drag !< If true, apply wave breaking as a sink. - real, dimension(:,:,:,:,:), pointer :: En => NULL() + real, allocatable :: En(:,:,:,:,:) !< The internal wave energy density as a function of (i,j,angle,frequency,mode) !! integrated within an angular and frequency band [R Z3 T-2 ~> J m-2] - real, dimension(:,:,:), pointer :: En_restart => NULL() + real, allocatable :: En_restart(:,:,:) !< The internal wave energy density as a function of (i,j,angle); temporary for restart real, allocatable, dimension(:) :: frequency !< The frequency of each band [T-1 ~> s-1]. @@ -169,8 +169,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Length of time over which to advance !! the internal tides [T ~> s]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct real, dimension(SZI_(G),SZJ_(G),CS%nMode), & intent(in) :: cn !< The internal wave speeds of each !! mode [L T-1 ~> m s-1]. @@ -210,7 +209,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(time_type) :: time_end logical:: avg_enabled - if (.not.associated(CS)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle I_rho0 = 1.0 / GV%Rho0 @@ -611,8 +609,7 @@ end subroutine propagate_int_tide !> Checks for energy conservation on computational domain subroutine sum_En(G, CS, En, label) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), & intent(in) :: En !< The energy density of the internal tides [R Z3 T-2 ~> J m-2]. character(len=*), intent(in) :: label !< A label to use in error messages @@ -654,8 +651,7 @@ end subroutine sum_En subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: Nb !< Near-bottom stratification [T-1 ~> s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & @@ -747,8 +743,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) integer, intent(in) :: i !< The i-index of the value to be reported. integer, intent(in) :: j !< The j-index of the value to be reported. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct character(len=*), intent(in) :: mechanism !< The named mechanism of loss to return real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified !! mechanism [R Z3 T-3 ~> W m-2]. @@ -1011,8 +1006,8 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. @@ -1137,8 +1132,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, intent(in) :: dt !< Time increment [T ~> s]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a previous - !! call to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables integer :: i, j, k, ish, ieh, jsh, jeh, m @@ -1405,8 +1399,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) !! edges of each angular band. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call - !! to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1480,8 +1473,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) !! edges of each angular band. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call - !! to continuity_PPM_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1641,8 +1633,7 @@ subroutine reflect(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c @@ -1748,8 +1739,7 @@ subroutine teleport(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), pointer :: CS !< The control structure returned by a - !! previous call to int_tide_init. + type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c @@ -2089,8 +2079,7 @@ end subroutine PPM_limit_pos ! subroutine register_int_tide_restarts(G, param_file, CS, restart_CS) ! type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure ! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! type(int_tide_CS), pointer :: CS !< The control structure returned by a -! !! previous call to int_tide_init. +! type(int_tide_CS), intent(in) :: CS !< Internal tide control struct ! type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! ! This subroutine is not currently in use!! @@ -2137,8 +2126,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. - type(int_tide_CS),pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + ! Local variables real :: Angle_size ! size of wedges, rad real, allocatable :: angles(:) ! orientations of wedge centers, rad @@ -2168,14 +2157,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "internal_tides_init called "//& - "with an associated control structure.") - return - else - allocate(CS) - endif - use_int_tides = .false. call read_param(param_file, "INTERNAL_TIDES", use_int_tides) CS%do_int_tides = use_int_tides @@ -2583,18 +2564,13 @@ end subroutine internal_tides_init !> This subroutine deallocates the memory associated with the internal tides control structure subroutine internal_tides_end(CS) - type(int_tide_CS), pointer :: CS !< A pointer to the control structure returned by a previous - !! call to internal_tides_init, it will be deallocated here. - - if (associated(CS)) then - if (associated(CS%En)) deallocate(CS%En) - if (allocated(CS%frequency)) deallocate(CS%frequency) - if (allocated(CS%id_En_mode)) deallocate(CS%id_En_mode) - if (allocated(CS%id_Ub_mode)) deallocate(CS%id_Ub_mode) - if (allocated(CS%id_cp_mode)) deallocate(CS%id_cp_mode) - deallocate(CS) - endif - CS => NULL() + type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + + if (allocated(CS%En)) deallocate(CS%En) + if (allocated(CS%frequency)) deallocate(CS%frequency) + if (allocated(CS%id_En_mode)) deallocate(CS%id_En_mode) + if (allocated(CS%id_Ub_mode)) deallocate(CS%id_Ub_mode) + if (allocated(CS%id_cp_mode)) deallocate(CS%id_cp_mode) end subroutine internal_tides_end end module MOM_internal_tides diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d3f92e99cc..d849298cba 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -224,7 +224,6 @@ module MOM_diabatic_driver type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module - type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module @@ -237,6 +236,7 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module + type(int_tide_CS) :: int_tide !< Internal tide control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -376,7 +376,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide) if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides @@ -3399,11 +3399,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_int_tides) then call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, & CS%int_tide_input) - call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide_CSp) + call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide) endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide_CSp, & + call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide, & halo_TS=CS%halo_TS_diff, double_diffuse=CS%double_diffuse) if (CS%useKPP .and. (CS%double_diffuse .and. .not.CS%use_CVMix_ddiff)) & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b1a4d1433d..b77cdf747f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1954,9 +1954,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output. type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control !! structure. - type(int_tide_CS), pointer :: int_tide_CSp !< A pointer to the internal tides control - !! structure - integer, intent(out) :: halo_TS !< The halo size of tracer points that must be + type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control struct + integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. logical, intent(out) :: double_diffuse !< This indicates whether some version !! of double diffusion is being used. @@ -1990,7 +1989,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed CS%diag => diag - if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp + CS%int_tide_CSp => int_tide_CSp ! These default values always need to be set. CS%BBL_mixing_as_max = .true. From 4b6f45ee8f96d20d3b46582307b1bc7e29b24cea Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 7 Oct 2021 00:27:02 -0400 Subject: [PATCH 039/138] Entrain diffusive pointer removal This removes just about all of the entrain_diffusive pointers (except the diag_ctrl). There is a very minor incongruity with `just_read_params`, which was originally used to deallocate the CS, which might alter some removed `if(associated(CS))` checks. But it seems this is not really a problem, since the calls to entrainment_diffusion() are inside regions unreachable when this flag (from `CS%useALEalgorithm`) is true. --- .../vertical/MOM_diabatic_driver.F90 | 12 +++--- .../vertical/MOM_entrain_diffusive.F90 | 37 ++++--------------- 2 files changed, 12 insertions(+), 37 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d849298cba..ff9f8fb4dc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -30,7 +30,7 @@ module MOM_diabatic_driver use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD use MOM_entrain_diffusive, only : entrainment_diffusive, entrain_diffusive_init -use MOM_entrain_diffusive, only : entrain_diffusive_end, entrain_diffusive_CS +use MOM_entrain_diffusive, only : entrain_diffusive_CS use MOM_EOS, only : calculate_density, calculate_TFreeze, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module @@ -236,7 +235,8 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module - type(int_tide_CS) :: int_tide !< Internal tide control struct + type(int_tide_CS) :: int_tide !< Internal tide control struct + type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -1921,7 +1921,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_entrain) ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & + call Entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive, & ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -3388,7 +3388,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise it is False. CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv_CSp) - call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive_CSp, & + call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive, & just_read_params=CS%useALEalgorithm) ! initialize the geothermal heating module @@ -3487,8 +3487,6 @@ subroutine diabatic_driver_end(CS) deallocate(CS%geothermal_CSp) endif - call entrain_diffusive_end(CS%entrain_diffusive_CSp) - if (CS%use_CVMix_conv) deallocate(CS%CVMix_conv_CSp) if (CS%useKPP) then diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 4dc08284af..e279092fef 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -18,7 +18,7 @@ module MOM_entrain_diffusive #include -public entrainment_diffusive, entrain_diffusive_init, entrain_diffusive_end +public entrainment_diffusive, entrain_diffusive_init ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -60,7 +60,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & type(forcing), intent(in) :: fluxes !< A structure of surface fluxes that may !! be used. real, intent(in) :: dt !< The time increment [T ~> s]. - type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous + type(entrain_diffusive_CS), intent(in) :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: ea !< The amount of fluid entrained from the layer @@ -207,9 +207,6 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & Angstrom = GV%Angstrom_H h_neglect = GV%H_subroundoff - if (.not. associated(CS)) call MOM_error(FATAL, & - "MOM_entrain_diffusive: Module must be initialized before it is used.") - if (.not.(present(Kd_Lay) .or. present(Kd_int))) call MOM_error(FATAL, & "MOM_entrain_diffusive: Either Kd_Lay or Kd_int must be present in call.") @@ -1022,7 +1019,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which !! i-points to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< The meridional index upon which to work. real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Ent_bl !< The average entrainment upward and @@ -1440,7 +1437,7 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & !! uppermost interior layer [H ~> m or kg m-2] integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: i !< The i-index to work on - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: ea_kb !< The entrainment from above by the layer below !! the buffer layer (i.e. layer kb) [H ~> m or kg m-2]. real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination @@ -1582,7 +1579,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & integer, intent(in) :: ie !< The end of the i-index range to work on. logical, dimension(SZI_(G)), intent(in) :: do_i !< A logical variable indicating which !! i-points to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: Ent !< The entrainment rate of the uppermost !! interior layer [H ~> m or kg m-2]. !! The input value is the first guess. @@ -1786,7 +1783,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + type(entrain_diffusive_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F !! = ent*ds_kb*I_dSkbp1 found in the range !! min_ent < ent < max_ent [H ~> m or kg m-2]. @@ -2067,8 +2064,7 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(entrain_diffusive_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure. + type(entrain_diffusive_CS), intent(inout) :: CS !< Entrainment diffusion control struct logical, intent(in) :: just_read_params !< If true, this call will only read !! and log parameters without registering !! any diagnostics @@ -2080,13 +2076,6 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re # include "version_variable.h" character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "entrain_diffusive_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - CS%diag => diag CS%bulkmixedlayer = (GV%nkml > 0) @@ -2115,20 +2104,8 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re 'Work actually done by diapycnal diffusion across each interface', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) endif - - if (just_read_params) deallocate(CS) - end subroutine entrain_diffusive_init -!> This subroutine cleans up and deallocates any memory associated with the -!! entrain_diffusive module. -subroutine entrain_diffusive_end(CS) - type(entrain_diffusive_CS), pointer :: CS !< A pointer to the control structure for this - !! module that will be deallocated. - if (associated(CS)) deallocate(CS) - -end subroutine entrain_diffusive_end - !> \namespace mom_entrain_diffusive !! !! By Robert Hallberg, September 1997 - July 2000 From 2540b4e615b8577ecc7b9548366329ea82275b28 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 7 Oct 2021 15:42:46 -0400 Subject: [PATCH 040/138] Tidal mixing pointer cleanup * `tidal_mixing_CS` pointers moved to locals * `tidal_mixing_CSp` in diffusivity renamed to `tidal_mixing` * Most of the pointer-declared fields converted to allocatables. * Local `dd` pointers to `CS%dd` removed * Reorder calculate_tidal_mixing (and sub-procedure) args --- .../vertical/MOM_set_diffusivity.F90 | 22 +- .../vertical/MOM_tidal_mixing.F90 | 432 +++++++++--------- 2 files changed, 218 insertions(+), 236 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b77cdf747f..dce302372e 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -161,7 +161,7 @@ module MOM_set_diffusivity type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() !< Control structure for a child module type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() !< Control structure for a child module type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module - type(tidal_mixing_cs), pointer :: tidal_mixing_CSp => NULL() !< Control structure for a child module + type(tidal_mixing_cs) :: tidal_mixing !< Control structure for a child module !>@{ Diagnostic IDs integer :: id_maxTKE = -1, id_TKE_to_Kd = -1, id_Kd_user = -1 @@ -326,7 +326,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! set up arrays for tidal mixing diagnostics if (CS%use_tidal_mixing) & - call setup_tidal_diagnostics(G, GV, CS%tidal_mixing_CSp) + call setup_tidal_diagnostics(G, GV, CS%tidal_mixing) if (CS%useKappaShear) then if (CS%debug) then @@ -493,8 +493,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! Add the Nikurashin and / or tidal bottom-driven mixing if (CS%use_tidal_mixing) & - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tidal_mixing_CSp, & - N2_lay, N2_int, Kd_lay_2d, Kd_int_2d, CS%Kd_max, visc%Kv_slow) + call calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, & + maxTKE, G, GV, US, CS%tidal_mixing, & + CS%Kd_max, visc%Kv_slow, Kd_lay_2d, Kd_int_2d) + ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then @@ -609,7 +611,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! tidal mixing if (CS%use_tidal_mixing) & - call post_tidal_diagnostics(G, GV, h, CS%tidal_mixing_CSp) + call post_tidal_diagnostics(G, GV, h, CS%tidal_mixing) if (CS%id_N2 > 0) call post_data(CS%id_N2, dd%N2_3d, CS%diag) if (CS%id_Kd_Work > 0) call post_data(CS%id_Kd_Work, dd%Kd_Work, CS%diag) @@ -965,7 +967,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) enddo - if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing_CSp) + if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing) do k=nz,2,-1 do_any = .false. @@ -2019,7 +2021,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, & - CS%int_tide_CSp, diag, CS%tidal_mixing_CSp) + CS%int_tide_CSp, diag, CS%tidal_mixing) call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& @@ -2296,10 +2298,8 @@ subroutine set_diffusivity_end(CS) call bkgnd_mixing_end(CS%bkgnd_mixing_csp) - if (CS%use_tidal_mixing) then - call tidal_mixing_end(CS%tidal_mixing_CSp) - deallocate(CS%tidal_mixing_CSp) - endif + if (CS%use_tidal_mixing) & + call tidal_mixing_end(CS%tidal_mixing) if (CS%user_change_diff) call user_change_diff_end(CS%user_change_diff_CSp) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 760e9ee8ec..b11bb2d8b2 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -43,30 +43,27 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private - real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] - Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] - Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] - N2_int => NULL(),& !< Bouyancy frequency squared at interfaces [T-2 ~> s-2] - vert_dep_3d => NULL(),& !< The 3-d mixing energy deposition [W m-3] - Schmittner_coeff_3d => NULL() !< The coefficient in the Schmittner et al mixing scheme, in UNITS? - real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, - !! interpolated to model vertical coordinate [W m-3?] - real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. - real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent - !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] - real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2] - N2_bot => NULL(),& !< bottom squared buoyancy frequency [T-2 ~> s-2] - N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [T-2 ~> s-2] - Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation [Z ~> m] - Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin [Z ~> m] - Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient - + real, allocatable :: Kd_itidal(:,:,:) !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Fl_itidal(:,:,:) !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] + real, allocatable :: Kd_Niku(:,:,:) !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Kd_Niku_work(:,:,:) !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] + real, allocatable :: Kd_Itidal_Work(:,:,:) !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] + real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] + real, allocatable :: N2_int(:,:,:) !< Bouyancy frequency squared at interfaces [T-2 ~> s-2] + real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition [W m-3] + real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme, in UNITS? + real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally, + !! interpolated to model vertical coordinate [W m-3?] + real, allocatable :: Kd_lowmode(:,:,:) !< internal tide diffusivity at interfaces + !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Fl_lowmode(:,:,:) !< vertical flux of tidal turbulent + !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] + real, allocatable :: TKE_itidal_used(:,:) !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2] + real, allocatable :: N2_bot(:,:) !< bottom squared buoyancy frequency [T-2 ~> s-2] + real, allocatable :: N2_meanz(:,:) !< vertically averaged buoyancy frequency [T-2 ~> s-2] + real, allocatable :: Polzin_decay_scale_scaled(:,:) !< vertical scale of decay for tidal dissipation [Z ~> m] + real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal diss with Polzin [Z ~> m] + real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient end type !> Control structure with parameters for the tidal mixing module. @@ -147,22 +144,23 @@ module MOM_tidal_mixing !! recover the remapping answers from 2018. If false, use more !! robust forms of the same remapping expressions. - ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input - !! [R Z3 T-3 ~> W m-2] - real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratfication [R Z3 T-2 ~> J m-2]. - real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [T-1 ~> s-1]. - real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input - real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [Z2 ~> m2]. - real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [Z T-1 ~> m s-1] type(int_tide_CS), pointer :: int_tide_CSp=> NULL() !< Control structure for a child module - real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] - real, allocatable, dimension(:,:) :: tidal_qe_2d !< Tidal energy input times the local dissipation - !! fraction, q*E(x,y), with the CVMix implementation - !! of Jayne et al tidal mixing [W m-2]. - !! TODO: make this E(x,y) only - real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + + ! Data containers + real, allocatable :: TKE_Niku(:,:) !< Lee wave driven Turbulent Kinetic Energy input + !! [R Z3 T-3 ~> W m-2] + real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided + !! by the bottom stratfication [R Z3 T-2 ~> J m-2]. + real, allocatable :: Nb(:,:) !< The near bottom buoyancy frequency [T-1 ~> s-1]. + real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input + real, allocatable :: h2(:,:) !< Squared bottom depth variance [Z2 ~> m2]. + real, allocatable :: tideamp(:,:) !< RMS tidal amplitude [Z T-1 ~> m s-1] + real, allocatable :: h_src(:) !< tidal constituent input layer thickness [m] + real, allocatable :: tidal_qe_2d(:,:) !< Tidal energy input times the local dissipation + !! fraction, q*E(x,y), with the CVMix implementation + !! of Jayne et al tidal mixing [W m-2]. + !! TODO: make this E(x,y) only + real, allocatable :: tidal_qe_3d_in(:,:,:) !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the !! answers from the end of 2018. Otherwise, use updated and more robust @@ -170,7 +168,7 @@ module MOM_tidal_mixing ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing - type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays + type(tidal_mixing_diags) :: dd !< Tidal mixing diagnostic arrays !>@{ Diagnostic identifiers integer :: id_TKE_itidal = -1 @@ -219,7 +217,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(int_tide_CS),target, intent(in) :: int_tide_CSp !< A pointer to the internal tides control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. ! Local variables logical :: use_CVMix_tidal @@ -239,12 +237,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di # include "version_variable.h" character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "tidal_mixing_init called when control structure "// & - "is already associated.") - return - endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -271,8 +263,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di tidal_mixing_init = int_tide_dissipation if (.not. tidal_mixing_init) return - allocate(CS) - allocate(CS%dd) CS%debug = CS%debug.and.is_root_pe() CS%diag => diag CS%int_tide_CSp => int_tide_CSp @@ -435,10 +425,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & .not. CS%use_CVMix_tidal) then - call safe_alloc_ptr(CS%Nb,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%h2,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%TKE_itidal,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%mask_itidal,isd,ied,jsd,jed) ; CS%mask_itidal(:,:) = 1.0 + allocate(CS%Nb(isd:ied,jsd:jed), source=0.) + allocate(CS%h2(isd:ied,jsd:jed), source=0.) + allocate(CS%TKE_itidal(isd:ied,jsd:jed), source=0.) + allocate(CS%mask_itidal(isd:ied,jsd:jed), source=1.) call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& @@ -448,7 +438,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) - call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide + allocate(CS%tideamp(is:ie,js:je), source=CS%utide) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & "A scaling factor for the roughness amplitude with "//& @@ -523,7 +513,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & filename) - call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je) ; CS%TKE_Niku(:,:) = 0.0 + allocate(CS%TKE_Niku(is:ie,js:je), source=0.) call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja scale=Niku_scale*US%W_m2_to_RZ3_T3) @@ -678,20 +668,20 @@ end function tidal_mixing_init !> Depending on whether or not CVMix is active, calls the associated subroutine to compute internal !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. -subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & - N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv) +subroutine calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kv, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the !! interfaces [T-2 ~> s-2]. - integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, @@ -699,25 +689,25 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, - !! [Z2 T-1 ~> m2 s-1]. + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZK_(GV)), & + optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZK_(GV)+1), & + optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, + !! [Z2 T-1 ~> m2 s-1]. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) + call calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) else - call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & - G, GV, US, CS, N2_lay, Kd_lay, Kd_int, Kd_max) + call add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kd_lay, Kd_int) endif endif end subroutine calculate_tidal_mixing @@ -725,22 +715,22 @@ end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) - integer, intent(in) :: j !< The j-index to work on +subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy - !! frequency at the interfaces [T-2 ~> s-2]. + type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + integer, intent(in) :: j !< The j-index to work on + real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy + !! frequency at the interfaces [T-2 ~> s-2]. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! Local variables real, dimension(SZK_(GV)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] @@ -759,10 +749,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) - type(tidal_mixing_diags), pointer :: dd => NULL() is = G%isc ; ie = G%iec - dd => CS%dd select case (CS%CVMix_tidal_scheme) case (SIMMONS) @@ -832,17 +820,17 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv endif ! diagnostics - if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + if (allocated(CS%dd%Kd_itidal)) then + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif - if (associated(dd%N2_int)) then - dd%N2_int(i,j,:) = N2_int(i,:) + if (allocated(CS%dd%N2_int)) then + CS%dd%N2_int(i,j,:) = N2_int(i,:) endif - if (associated(dd%Simmons_coeff_2d)) then - dd%Simmons_coeff_2d(i,j) = Simmons_coeff + if (allocated(CS%dd%Simmons_coeff_2d)) then + CS%dd%Simmons_coeff_2d(i,j) = Simmons_coeff endif - if (associated(dd%vert_dep_3d)) then - dd%vert_dep_3d(i,j,:) = vert_dep(:) + if (allocated(CS%dd%vert_dep_3d)) then + CS%dd%vert_dep_3d(i,j,:) = vert_dep(:) endif enddo ! i=is,ie @@ -933,20 +921,20 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv endif ! diagnostics - if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + if (allocated(CS%dd%Kd_itidal)) then + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif - if (associated(dd%N2_int)) then - dd%N2_int(i,j,:) = N2_int(i,:) + if (allocated(CS%dd%N2_int)) then + CS%dd%N2_int(i,j,:) = N2_int(i,:) endif - if (associated(dd%Schmittner_coeff_3d)) then - dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) + if (allocated(CS%dd%Schmittner_coeff_3d)) then + CS%dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) endif - if (associated(dd%tidal_qe_md)) then - dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) + if (allocated(CS%dd%tidal_qe_md)) then + CS%dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) endif - if (associated(dd%vert_dep_3d)) then - dd%vert_dep_3d(i,j,:) = vert_dep(:) + if (allocated(CS%dd%vert_dep_3d)) then + CS%dd%vert_dep_3d(i,j,:) = vert_dep(:) endif enddo ! i=is,ie @@ -966,18 +954,18 @@ end subroutine calculate_CVMix_tidal !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). -subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & - N2_lay, Kd_lay, Kd_int, Kd_max) +subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & + G, GV, US, CS, Kd_max, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. - integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, @@ -985,16 +973,16 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module + real, intent(in) :: Kd_max !< The maximum increment for diapycnal + !! diffusivity due to TKE-based processes + !! [Z2 T-1 ~> m2 s-1]. + !! Set this to a negative value to have no limit. real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces !! [Z2 T-1 ~> m2 s-1]. - real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes - !! [Z2 T-1 ~> m2 s-1]. - !! Set this to a negative value to have no limit. ! local @@ -1041,10 +1029,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, character(len=160) :: mesg ! The text of an error message integer :: i, k, is, ie, nz integer :: a, fr, m - type(tidal_mixing_diags), pointer :: dd => NULL() is = G%isc ; ie = G%iec ; nz = GV%ke - dd => CS%dd if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return @@ -1070,7 +1056,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, GV%H_subroundoff*GV%H_to_Z) do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) + if (allocated(CS%dd%N2_bot)) & + CS%dd%N2_bot(i,j) = N2_bot(i) if ( CS%Int_tide_dissipation ) then if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) @@ -1099,7 +1086,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, enddo ; enddo do i=is,ie N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) - if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) + if (allocated(CS%dd%N2_meanz)) & + CS%dd%N2_meanz(i,j) = N2_meanz(i) enddo ! WKB scaled z*(z=H) z* at the surface using the modified Polzin WKB scaling @@ -1150,11 +1138,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, endif endif - if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = z0_polzin(i) - if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) + if (allocated(CS%dd%Polzin_decay_scale)) & + CS%dd%Polzin_decay_scale(i,j) = z0_polzin(i) + if (allocated(CS%dd%Polzin_decay_scale_scaled)) & + CS%dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) + if (allocated(CS%dd%N2_bot)) & + CS%dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if (CS%answers_2018) then ! These expressions use dimensional constants to avoid NaN values. @@ -1206,8 +1195,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie ! Dissipation of locally trapped internal tide (non-propagating high modes) TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) - if (associated(dd%TKE_itidal_used)) & - dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) + if (allocated(CS%dd%TKE_itidal_used)) & + CS%dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) ! Dissipation of locally trapped lee waves TKE_Niku_bot(i) = 0.0 @@ -1227,7 +1216,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_Niku_rem(i) = Inv_int_lee(i) * TKE_Niku_bot(i) TKE_lowmode_rem(i) = Inv_int_low(i) * TKE_lowmode_bot(i) - if (associated(dd%Fl_itidal)) dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM + if (allocated(CS%dd%Fl_itidal)) & + CS%dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM enddo ! Estimate the work that would be done by mixing in each layer. @@ -1275,42 +1265,43 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, endif ! diagnostics - if (associated(dd%Kd_itidal)) then - ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay + if (allocated(CS%dd%Kd_itidal)) then + ! If at layers, CS%dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_itidal(i,j,K) = CS%dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_Niku(i,j,K) = CS%dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_lowmode(i,j,K) = CS%dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_itidal(i,j,K) = CS%dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_Niku(i,j,K) = CS%dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k1) CS%dd%Kd_lowmode(i,j,K) = CS%dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k NULL() isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = GV%ke - dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) & - allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + allocate(CS%dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) & - allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Fl_itidal > 0) allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Fl_lowmode > 0) allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Polzin_decay_scale > 0) allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) - if (CS%id_N2_bot > 0) allocate(dd%N2_bot(isd:ied,jsd:jed), source=0.0) - if (CS%id_N2_meanz > 0) allocate(dd%N2_meanz(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_itidal > 0) allocate(CS%dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_lowmode > 0) allocate(CS%dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Polzin_decay_scale > 0) allocate(CS%dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_bot > 0) allocate(CS%dd%N2_bot(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_meanz > 0) allocate(CS%dd%N2_meanz(isd:ied,jsd:jed), source=0.0) if (CS%id_Polzin_decay_scale_scaled > 0) & - allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) & - allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) - if (CS%id_Kd_Niku_work > 0) allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_Kd_Itidal_work > 0) allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_Kd_Lowmode_Work > 0) allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) - if (CS%id_TKE_itidal > 0) allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) + allocate(CS%dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_Niku_work > 0) allocate(CS%dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Itidal_work > 0) allocate(CS%dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Lowmode_Work > 0) allocate(CS%dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_TKE_itidal > 0) allocate(CS%dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) ! additional diags for CVMix - if (CS%id_N2_int > 0) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_N2_int > 0) allocate(CS%dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif - allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) + allocate(CS%dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) endif - if (CS%id_vert_dep > 0) allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_vert_dep > 0) allocate(CS%dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) endif end subroutine setup_tidal_diagnostics @@ -1474,63 +1463,57 @@ subroutine post_tidal_diagnostics(G, GV, h ,CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - - ! local - type(tidal_mixing_diags), pointer :: dd => NULL() - - dd => CS%dd + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then - if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, dd%TKE_itidal_used, CS%diag) + if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, CS%dd%TKE_itidal_used, CS%diag) if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, CS%TKE_Niku, CS%diag) if (CS%id_Nb > 0) call post_data(CS%id_Nb, CS%Nb, CS%diag) - if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, dd%N2_bot, CS%diag) - if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,dd%N2_meanz,CS%diag) + if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, CS%dd%N2_bot, CS%diag) + if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,CS%dd%N2_meanz,CS%diag) - if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, dd%Fl_itidal, CS%diag) - if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, dd%Kd_itidal, CS%diag) - if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, dd%Kd_Niku, CS%diag) - if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, dd%Kd_lowmode, CS%diag) - if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, dd%Fl_lowmode, CS%diag) + if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, CS%dd%Fl_itidal, CS%diag) + if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, CS%dd%Kd_itidal, CS%diag) + if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, CS%dd%Kd_Niku, CS%diag) + if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, CS%dd%Kd_lowmode, CS%diag) + if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, CS%dd%Fl_lowmode, CS%diag) - if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, dd%N2_int, CS%diag) - if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) - if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) - if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, dd%Schmittner_coeff_3d, CS%diag) - if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, dd%tidal_qe_md, CS%diag) + if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, CS%dd%N2_int, CS%diag) + if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, CS%dd%vert_dep_3d, CS%diag) + if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, CS%dd%Simmons_coeff_2d, CS%diag) + if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, CS%dd%Schmittner_coeff_3d, CS%diag) + if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, CS%dd%tidal_qe_md, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & - call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) - if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, dd%Kd_Niku_Work, CS%diag) + call post_data(CS%id_Kd_Itidal_Work, CS%dd%Kd_Itidal_Work, CS%diag) + if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, CS%dd%Kd_Niku_Work, CS%diag) if (CS%id_Kd_Lowmode_Work > 0) & - call post_data(CS%id_Kd_Lowmode_Work, dd%Kd_Lowmode_Work, CS%diag) + call post_data(CS%id_Kd_Lowmode_Work, CS%dd%Kd_Lowmode_Work, CS%diag) if (CS%id_Polzin_decay_scale > 0 ) & - call post_data(CS%id_Polzin_decay_scale, dd%Polzin_decay_scale, CS%diag) + call post_data(CS%id_Polzin_decay_scale, CS%dd%Polzin_decay_scale, CS%diag) if (CS%id_Polzin_decay_scale_scaled > 0 ) & - call post_data(CS%id_Polzin_decay_scale_scaled, dd%Polzin_decay_scale_scaled, CS%diag) + call post_data(CS%id_Polzin_decay_scale_scaled, CS%dd%Polzin_decay_scale_scaled, CS%diag) endif - if (associated(dd%Kd_itidal)) deallocate(dd%Kd_itidal) - if (associated(dd%Kd_lowmode)) deallocate(dd%Kd_lowmode) - if (associated(dd%Fl_itidal)) deallocate(dd%Fl_itidal) - if (associated(dd%Fl_lowmode)) deallocate(dd%Fl_lowmode) - if (associated(dd%Polzin_decay_scale)) deallocate(dd%Polzin_decay_scale) - if (associated(dd%Polzin_decay_scale_scaled)) deallocate(dd%Polzin_decay_scale_scaled) - if (associated(dd%N2_bot)) deallocate(dd%N2_bot) - if (associated(dd%N2_meanz)) deallocate(dd%N2_meanz) - if (associated(dd%Kd_Niku)) deallocate(dd%Kd_Niku) - if (associated(dd%Kd_Niku_work)) deallocate(dd%Kd_Niku_work) - if (associated(dd%Kd_Itidal_Work)) deallocate(dd%Kd_Itidal_Work) - if (associated(dd%Kd_Lowmode_Work)) deallocate(dd%Kd_Lowmode_Work) - if (associated(dd%TKE_itidal_used)) deallocate(dd%TKE_itidal_used) - if (associated(dd%N2_int)) deallocate(dd%N2_int) - if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) - if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) - if (associated(dd%Schmittner_coeff_3d)) deallocate(dd%Schmittner_coeff_3d) - if (associated(dd%tidal_qe_md)) deallocate(dd%tidal_qe_md) - + if (allocated(CS%dd%Kd_itidal)) deallocate(CS%dd%Kd_itidal) + if (allocated(CS%dd%Kd_lowmode)) deallocate(CS%dd%Kd_lowmode) + if (allocated(CS%dd%Fl_itidal)) deallocate(CS%dd%Fl_itidal) + if (allocated(CS%dd%Fl_lowmode)) deallocate(CS%dd%Fl_lowmode) + if (allocated(CS%dd%Polzin_decay_scale)) deallocate(CS%dd%Polzin_decay_scale) + if (allocated(CS%dd%Polzin_decay_scale_scaled)) deallocate(CS%dd%Polzin_decay_scale_scaled) + if (allocated(CS%dd%N2_bot)) deallocate(CS%dd%N2_bot) + if (allocated(CS%dd%N2_meanz)) deallocate(CS%dd%N2_meanz) + if (allocated(CS%dd%Kd_Niku)) deallocate(CS%dd%Kd_Niku) + if (allocated(CS%dd%Kd_Niku_work)) deallocate(CS%dd%Kd_Niku_work) + if (allocated(CS%dd%Kd_Itidal_Work)) deallocate(CS%dd%Kd_Itidal_Work) + if (allocated(CS%dd%Kd_Lowmode_Work)) deallocate(CS%dd%Kd_Lowmode_Work) + if (allocated(CS%dd%TKE_itidal_used)) deallocate(CS%dd%TKE_itidal_used) + if (allocated(CS%dd%N2_int)) deallocate(CS%dd%N2_int) + if (allocated(CS%dd%vert_dep_3d)) deallocate(CS%dd%vert_dep_3d) + if (allocated(CS%dd%Simmons_coeff_2d)) deallocate(CS%dd%Simmons_coeff_2d) + if (allocated(CS%dd%Schmittner_coeff_3d)) deallocate(CS%dd%Schmittner_coeff_3d) + if (allocated(CS%dd%tidal_qe_md)) deallocate(CS%dd%tidal_qe_md) end subroutine post_tidal_diagnostics !> This subroutine returns a zonal slice of the topographic roughness amplitudes @@ -1538,7 +1521,7 @@ subroutine tidal_mixing_h_amp(h_amp, G, j, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G)), intent(out) :: h_amp !< The topographic roughness amplitude [Z ~> m] integer, intent(in) :: j !< j-index of the row to work on - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(in) :: CS !< The control structure for this module integer :: i @@ -1558,7 +1541,7 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local integer :: i, j, isd, ied, jsd, jed real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points [W m-2] @@ -1587,7 +1570,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidal energy inputs - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local variables real, parameter :: C1_3 = 1.0/3.0 @@ -1694,7 +1677,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) end subroutine read_tidal_constituents -!> Clear pointers and deallocate memory +!> Deallocate fields subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure, which !! will be deallocated in this routine. @@ -1703,7 +1686,6 @@ subroutine tidal_mixing_end(CS) if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) if (allocated(CS%tidal_qe_3d_in)) deallocate(CS%tidal_qe_3d_in) if (allocated(CS%h_src)) deallocate(CS%h_src) - deallocate(CS%dd) end subroutine tidal_mixing_end end module MOM_tidal_mixing From e50c667796d7bdfad0c7cd50f4fe1315f7140c8a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 8 Oct 2021 17:33:04 -0400 Subject: [PATCH 041/138] Geothermal heating pointer removal * `geothermal_CS` converted from pointers to locals * Instance of `geothermal_CS` in diabatic driver changed to local --- .../vertical/MOM_diabatic_driver.F90 | 18 +++++++-------- .../vertical/MOM_geothermal.F90 | 23 ++++--------------- 2 files changed, 13 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ff9f8fb4dc..d6c45a1508 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -222,7 +222,6 @@ module MOM_diabatic_driver type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module - type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module @@ -235,8 +234,9 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module - type(int_tide_CS) :: int_tide !< Internal tide control struct type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct + type(geothermal_CS) :: geothermal !< Geothermal control struct + type(int_tide_CS) :: int_tide !< Internal tide control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -549,7 +549,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -1134,7 +1134,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_in_place(h, tv, dt, G, GV, US, CS%geothermal, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -1686,7 +1686,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal_entraining(h, tv, dt, eaml, ebml, G, GV, US, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal_entraining(h, tv, dt, eaml, ebml, G, GV, US, CS%geothermal, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) @@ -3393,7 +3393,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! initialize the geothermal heating module if (CS%use_geothermal) & - call geothermal_init(Time, G, GV, US, param_file, diag, CS%geothermal_CSp, useALEalgorithm) + call geothermal_init(Time, G, GV, US, param_file, diag, CS%geothermal, useALEalgorithm) ! initialize module for internal tide induced mixing if (CS%use_int_tides) then @@ -3482,10 +3482,8 @@ subroutine diabatic_driver_end(CS) deallocate(CS%set_diff_CSp) - if (CS%use_geothermal) then - call geothermal_end(CS%geothermal_CSp) - deallocate(CS%geothermal_CSp) - endif + if (CS%use_geothermal) & + call geothermal_end(CS%geothermal) if (CS%use_CVMix_conv) deallocate(CS%CVMix_conv_CSp) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 877f9a0497..7fdaa6abda 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -65,7 +65,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) !! increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(geothermal_CS), pointer :: CS !< The control structure returned by + type(geothermal_CS), intent(in) :: CS !< The control structure returned by !! a previous call to !! geothermal_init. integer, optional, intent(in) :: halo !< Halo width over which to work @@ -119,8 +119,6 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& - "Module must be initialized before it is used.") if (.not.CS%apply_geothermal) return nkmb = GV%nk_rho_varies @@ -367,8 +365,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) !! to any available thermodynamic fields. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(geothermal_CS), pointer :: CS !< The control structure returned by - !! a previous call to geothermal_init. + type(geothermal_CS), intent(in) :: CS !< Geothermal heating control struct integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables @@ -395,8 +392,6 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo endif - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& - "Module must be initialized before it is used.") if (.not.CS%apply_geothermal) return Irho_cp = 1.0 / (GV%H_to_RZ * tv%C_p) @@ -497,9 +492,8 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. - type(geothermal_CS), pointer :: CS !< Pointer pointing to the module control - !! structure. - logical, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping + type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control struct + logical, optional, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping ! This include declares and sets the variable "version". #include "version_variable.h" @@ -512,12 +506,6 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith integer :: i, j, isd, ied, jsd, jed, id isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "geothermal_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time @@ -599,8 +587,7 @@ end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. subroutine geothermal_end(CS) - type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control structure that - !! will be deallocated in this subroutine. + type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control struct if (allocated(CS%geo_heat)) deallocate(CS%geo_heat) end subroutine geothermal_end From 1a3a20acd5acec333049bd0aab488eb17fb2b93b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 11 Oct 2021 16:26:28 -0400 Subject: [PATCH 042/138] Opacity pointer removal * Diabatic driver `opacity_CSp` renamed to `opacity`, changed to local * Instances of `optics` and `opacity_CS` converted to locals * Fields in `opacity_CS` and `optics_type` changed to allocatables --- .../vertical/MOM_diabatic_aux.F90 | 10 +-- .../vertical/MOM_diabatic_driver.F90 | 16 ++--- .../vertical/MOM_opacity.F90 | 67 ++++++++----------- 3 files changed, 41 insertions(+), 52 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 6739a92cc9..312d114dde 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -590,7 +590,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) end subroutine find_uv_at_h -subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_flow_CSp) +subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity, tracer_flow_CSp) type(optics_type), pointer :: optics !< An optics structure that has will contain !! information about shortwave fluxes and absorption. type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -599,7 +599,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux - type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. + type(opacity_CS) :: opacity !< The control structure for the opacity module. type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure !! organizing the tracer modules. @@ -629,7 +629,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ if (CS%id_chl > 0) call post_data(CS%id_chl, chl_2d, CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_2d=chl_2d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity, chl_2d=chl_2d) else if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & "The tracer flow control structure must be associated when the model sets "//& @@ -639,11 +639,11 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_ if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_3d=chl_3d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity, chl_3d=chl_3d) endif else call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity) endif end subroutine set_pen_shortwave diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d6c45a1508..809c962233 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -224,7 +224,6 @@ module MOM_diabatic_driver type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module - type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module @@ -237,6 +236,7 @@ module MOM_diabatic_driver type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(geothermal_CS) :: geothermal !< Geothermal control struct type(int_tide_CS) :: int_tide !< Internal tide control struct + type(opacity_CS) :: opacity !< Opacity control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -563,7 +563,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -1148,7 +1148,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -1700,7 +1700,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) if (CS%bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) @@ -2523,7 +2523,7 @@ end subroutine layered_diabatic !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, minimum_forcing_depth, & KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo) - type(diabatic_CS), intent(in ) :: CS !< module control structure + type(diabatic_CS), target, intent(in) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure type(optics_type), optional, pointer :: optics_CSp !< A pointer to be set to the optics control structure @@ -2539,7 +2539,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, !! assume thermodynamics properties are valid. ! Pointers to control structures - if (present(opacity_CSp)) opacity_CSp => CS%opacity_CSp + if (present(opacity_CSp)) opacity_CSp => CS%opacity if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL_CSp @@ -3449,7 +3449,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) - call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity_CSp, CS%optics) + call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity, CS%optics) endif endif @@ -3464,7 +3464,7 @@ subroutine diabatic_driver_end(CS) type(diabatic_CS), intent(inout) :: CS !< module control structure if (associated(CS%optics)) then - call opacity_end(CS%opacity_CSp, CS%optics) + call opacity_end(CS%opacity, CS%optics) deallocate(CS%optics) endif diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 507960cf1f..e61cc3736b 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -25,16 +25,17 @@ module MOM_opacity type, public :: optics_type integer :: nbands !< The number of penetrating bands of SW radiation - real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] + real, allocatable :: opacity_band(:,:,:,:) !< SW optical depth per unit thickness [m-1] !! The number of radiation bands is most rapidly varying (first) index. - real, pointer, dimension(:,:,:) :: sw_pen_band => NULL() !< shortwave radiation [Q R Z T-1 ~> W m-2] + real, allocatable :: sw_pen_band(:,:,:) !< shortwave radiation [Q R Z T-1 ~> W m-2] !! at the surface in each of the nbands bands that penetrates beyond the surface. !! The most rapidly varying dimension is the band. - real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + real, allocatable :: min_wavelength_band(:) + !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + real, allocatable :: max_wavelength_band(:) + !< The maximum wavelength in each band of penetrating shortwave radiation [nm] real :: PenSW_flux_absorb !< A heat flux that is small enough to be completely absorbed in the next !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. @@ -69,7 +70,7 @@ module MOM_opacity !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1 - integer, pointer :: id_opacity(:) => NULL() + integer, allocatable :: id_opacity(:) !>@} end type opacity_CS @@ -100,7 +101,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(opacity_CS), pointer :: CS !< The control structure earlier set up by opacity_init. + type(opacity_CS) :: CS !< The control structure earlier set up by opacity_init. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -118,9 +119,6 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ ! summed across all bands [Q R Z T-1 ~> W m-2]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & - "Module must be initialized via opacity_init before it is used.") - if (present(chl_2d) .or. present(chl_3d)) then ! The optical properties are based on cholophyll concentrations. call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & @@ -229,7 +227,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(opacity_CS), pointer :: CS !< The control structure. + type(opacity_CS) :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -925,9 +923,8 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. - type(optics_type), pointer :: optics !< An optics structure that has parameters + type(opacity_CS) :: CS !< Opacity control struct + type(optics_type) :: optics !< An optics structure that has parameters !! set and arrays allocated here. ! Local variables character(len=200) :: tmpstr @@ -945,12 +942,6 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - if (associated(CS)) then - call MOM_error(WARNING, "opacity_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ! Read all relevant parameters and write them to the model log. @@ -1069,9 +1060,9 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) default=PenSW_minthick_dflt, units="m", scale=GV%m_to_H) optics%PenSW_absorb_Invlen = 1.0 / (PenSW_absorb_minthick + GV%H_subroundoff) - if (.not.associated(optics%min_wavelength_band)) & + if (.not.allocated(optics%min_wavelength_band)) & allocate(optics%min_wavelength_band(optics%nbands)) - if (.not.associated(optics%max_wavelength_band)) & + if (.not.allocated(optics%max_wavelength_band)) & allocate(optics%max_wavelength_band(optics%nbands)) if (CS%opacity_scheme == MANIZZA_05) then @@ -1093,9 +1084,9 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "The value to use for opacity over land. The default is "//& "10 m-1 - a value for muddy water.", units="m-1", default=10.0) - if (.not.associated(optics%opacity_band)) & + if (.not.allocated(optics%opacity_band)) & allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) - if (.not.associated(optics%sw_pen_band)) & + if (.not.allocated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) allocate(CS%id_opacity(optics%nbands), source=-1) @@ -1116,21 +1107,19 @@ end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS), pointer :: CS !< An opacity control structure that should be deallocated. - type(optics_type), pointer :: optics !< An optics type structure that should be deallocated. - - if (associated(CS%id_opacity)) deallocate(CS%id_opacity) - if (associated(CS)) deallocate(CS) - - if (associated(optics)) then - if (associated(optics%sw_pen_band)) deallocate(optics%sw_pen_band) - if (associated(optics%opacity_band)) deallocate(optics%opacity_band) - if (associated(optics%max_wavelength_band)) & - deallocate(optics%max_wavelength_band) - if (associated(optics%min_wavelength_band)) & - deallocate(optics%min_wavelength_band) - endif - + type(opacity_CS) :: CS !< Opacity control struct + type(optics_type) :: optics !< An optics type structure that should be deallocated. + + if (allocated(CS%id_opacity)) & + deallocate(CS%id_opacity) + if (allocated(optics%sw_pen_band)) & + deallocate(optics%sw_pen_band) + if (allocated(optics%opacity_band)) & + deallocate(optics%opacity_band) + if (allocated(optics%max_wavelength_band)) & + deallocate(optics%max_wavelength_band) + if (allocated(optics%min_wavelength_band)) & + deallocate(optics%min_wavelength_band) end subroutine opacity_end !> \namespace mom_opacity From 3152a9e312585d6b03da915a52d3568a68a30afe Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 15 Oct 2021 12:12:48 -0400 Subject: [PATCH 043/138] Bulk mixed layer pointer removal * `bulkmixedlayer_CS` pointers moved to locals * Diabatic driver renamed variables: * `bulkmixedlayer` flag -> `use_bulkmixedlayer` * `bulkmixedlayer_CSp` -> `bulkmixedlayer` * Some redundant documentation removed --- .../vertical/MOM_bulk_mixed_layer.F90 | 43 +++++-------------- .../vertical/MOM_diabatic_driver.F90 | 28 ++++++------ 2 files changed, 25 insertions(+), 46 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index be2dfefe8c..ca545c14ad 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -185,8 +185,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C intent(inout) :: eb !< The amount of fluid moved upward into a !! layer; this should be increased due to !! mixed layer entrainment [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct type(optics_type), pointer :: optics !< The structure containing the inverse of the !! vertical absorption decay scale for !! penetrating shortwave radiation [m-1]. @@ -329,8 +328,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//& - "Module must be initialized before it is used.") if (GV%nkml < 1) return if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & @@ -798,7 +795,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! [Z L2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment !! (perhaps CS%nkml). @@ -975,7 +972,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -1315,7 +1312,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. @@ -1525,7 +1522,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct ! This subroutine calculates mechanically driven entrainment. @@ -1808,8 +1805,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) !! the layers [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. ! Local variables @@ -1878,8 +1874,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! below [H ~> m or kg m-2]. Positive values go !! with mass gain by a layer. integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this - !! module. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential @@ -2194,8 +2189,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, @@ -3090,8 +3084,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! a layer. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a - !! previous call to mixedlayer_init. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature @@ -3358,16 +3351,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(bulkmixedlayer_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. @@ -3377,12 +3362,6 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 809c962233..c707dc495a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -92,7 +92,7 @@ module MOM_diabatic_driver logical :: use_legacy_diabatic !< If true (default), use a legacy version of the diabatic !! algorithm. This is temporary and is needed to avoid change !! in answers. - logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + logical :: use_bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary !! boundary layer scheme to determine the diffusivity @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module @@ -233,6 +232,7 @@ module MOM_diabatic_driver type(CVMix_conv_cs), pointer :: CVMix_conv_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module + type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(geothermal_CS) :: geothermal !< Geothermal control struct type(int_tide_CS) :: int_tide !< Internal tide control struct @@ -1702,7 +1702,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(CS%optics)) & call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity, CS%tracer_flow_CSp) - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) if (CS%ML_mix_first > 0.0) then @@ -1719,11 +1719,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & - eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + eaml, ebml, G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & - G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) endif @@ -1988,7 +1988,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! If using the bulk mixed layer, T and S are also updated ! by surface fluxes (in fluxes%*). ! This is a very long block. - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (associated(tv%T)) then call cpu_clock_begin(id_clock_tridiag) @@ -2107,7 +2107,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & - G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) ! Keep salinity from falling below a small but positive threshold. @@ -2310,7 +2310,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + if (CS%use_bulkmixedlayer .and. associated(tv%eqn_of_state)) then do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo EOSdom(:) = EOS_domain(G%HI) !$OMP parallel do default(shared) @@ -2359,7 +2359,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! For momentum, it is only the net flux that homogenizes within ! the mixed layer. Vertical viscosity that is proportional to the ! mixed layer turbulence is applied elsewhere. - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then if (CS%debug) then call hchksum(ea, "before net flux rearrangement ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "before net flux rearrangement eb", G%HI, scale=GV%H_to_m) @@ -2917,7 +2917,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (associated(oda_incupd_CSp)) CS%oda_incupd_CSp => oda_incupd_CSp CS%useALEalgorithm = useALEalgorithm - CS%bulkmixedlayer = (GV%nkml > 0) + CS%use_bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters call log_version(param_file, mdl, version, & @@ -2958,7 +2958,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%use_kappa_shear = kappa_shear_is_used(param_file) CS%use_CVMix_shear = CVMix_shear_is_used(param_file) - if (CS%bulkmixedlayer) then + if (CS%use_bulkmixedlayer) then call get_param(param_file, mdl, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied "//& "before interior diapycnal mixing. 0 by default.", & @@ -3412,7 +3412,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! set up the clocks for this module id_clock_entrain = cpu_clock_id('(Ocean diabatic entrain)', grain=CLOCK_MODULE) - if (CS%bulkmixedlayer) & + if (CS%use_bulkmixedlayer) & id_clock_mixedlayer = cpu_clock_id('(Ocean mixed layer)', grain=CLOCK_MODULE) id_clock_remap = cpu_clock_id('(Ocean vert remap)', grain=CLOCK_MODULE) if (CS%use_geothermal) & @@ -3434,8 +3434,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%useALEalgorithm, CS%use_energetic_PBL) ! initialize the boundary layer modules - if (CS%bulkmixedlayer) & - call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer_CSp) + if (CS%use_bulkmixedlayer) & + call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer) if (CS%use_energetic_PBL) & call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL_CSp) From e3d59fe0fd6cf43d03b6046d2599e2f38a3d9fc7 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 15 Oct 2021 15:01:17 -0400 Subject: [PATCH 044/138] Energetic PBL pointer removal * `energetic_PBL_CS` pointers changed to locals in main module * `energetic_PBL_CSp` changed to local and renamed to `energetic_PBL` in diabatic driver. --- .../vertical/MOM_diabatic_driver.F90 | 20 +++++------ .../vertical/MOM_energetic_PBL.F90 | 36 +++++-------------- 2 files changed, 18 insertions(+), 38 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c707dc495a..cefb8bc991 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module @@ -233,6 +232,7 @@ module MOM_diabatic_driver type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct + type(energetic_PBL_CS) :: energetic_PBL !< Energetic PBL control struct type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(geothermal_CS) :: geothermal !< Geothermal control struct type(int_tide_CS) :: int_tide !< Internal tide control struct @@ -779,15 +779,15 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -1315,15 +1315,15 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -2542,7 +2542,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(opacity_CSp)) opacity_CSp => CS%opacity if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp - if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL_CSp + if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit @@ -3437,7 +3437,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_bulkmixedlayer) & call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer) if (CS%use_energetic_PBL) & - call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL_CSp) + call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL) call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) @@ -3474,7 +3474,7 @@ subroutine diabatic_driver_end(CS) deallocate(CS%regularize_layers_CSp) if (CS%use_energetic_PBL) & - call energetic_PBL_end(CS%energetic_PBL_CSp) + call energetic_PBL_end(CS%energetic_PBL) call diabatic_aux_end(CS%diabatic_aux_CSp) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 946a40d39e..4a762cd34c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -277,8 +277,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 T-1 ~> m2 s-1]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to energetic_PBL_init. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -345,9 +344,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& - "Module must be initialized before it is used.") - if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & "energetic_PBL: Temperature, salinity and an equation of state "//& "must now be used.") @@ -526,8 +522,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !! [Z T-1 ~> m s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to energetic_PBL_init. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -731,9 +726,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& - "Module must be initialized before it is used.") - debug = .false. ! Change this hard-coded value for debugging. calc_Te = (debug .or. (.not.CS%orig_PE_calc)) @@ -1718,7 +1710,7 @@ end subroutine find_PE_chg_orig subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& BLD, Abs_Coriolis, MStar, Langmuir_Number,& MStar_LT, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1] real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1] @@ -1804,7 +1796,7 @@ end subroutine Find_Mstar !> This subroutine modifies the Mstar value if the Langmuir number is present subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langmuir_Number, & Mstar, MStar_LT, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Abs_Coriolis !< Absolute value of the Coriolis parameter [T-1 ~> s-1] real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] @@ -1890,7 +1882,7 @@ end subroutine Mstar_Langmuir !> Copies the ePBL active mixed layer depth into MLD, in units of [Z ~> m] unless other units are specified. subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) - type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL + type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control struct type(ocean_grid_type), intent(in) :: G !< Grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [Z ~> m] or other units @@ -1917,8 +1909,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output - type(energetic_PBL_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct + ! Local variables ! This include declares and sets the variable "version". # include "version_variable.h" @@ -1932,12 +1924,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "energetic_PBL_init called with an associated"//& - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time @@ -2360,14 +2346,11 @@ end subroutine energetic_PBL_init !> Clean up and deallocate memory associated with the energetic_PBL module. subroutine energetic_PBL_end(CS) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure that - !! will be deallocated in this subroutine. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic_PBL control struct character(len=256) :: mesg real :: avg_its - if (.not.associated(CS)) return - if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) if (allocated(CS%LA)) deallocate(CS%LA) if (allocated(CS%LA_MOD)) deallocate(CS%LA_MOD) @@ -2390,9 +2373,6 @@ subroutine energetic_PBL_end(CS) write (mesg,*) "Average ePBL iterations = ", avg_its call MOM_mesg(mesg) endif - - deallocate(CS) - end subroutine energetic_PBL_end !> \namespace MOM_energetic_PBL From d6e98dc8fac630b1f9e7bbc8963bbcb5c00bcebc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 15 Oct 2021 15:43:28 -0400 Subject: [PATCH 045/138] Regularize layers pointer removal * `regularize_layer_CS` pointers in module moved to local * `regularize_layer_CSp` in diabatic driver moved to local * diabatic drriver `regularize_layer_CSp` renamed to drop `_CSp` --- .../vertical/MOM_diabatic_driver.F90 | 8 +++--- .../vertical/MOM_regularize_layers.F90 | 27 +++++-------------- 2 files changed, 10 insertions(+), 25 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index cefb8bc991..5b33ec5f95 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -219,7 +219,6 @@ module MOM_diabatic_driver logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module @@ -237,6 +236,7 @@ module MOM_diabatic_driver type(geothermal_CS) :: geothermal !< Geothermal control struct type(int_tide_CS) :: int_tide !< Internal tide control struct type(opacity_CS) :: opacity !< Opacity control struct + type(regularize_layers_CS) :: regularize_layers !< Regularize layer control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -2183,7 +2183,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS%regularize_layers_CSp) + call regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS%regularize_layers) call cpu_clock_end(id_clock_remap) if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G, GV, US) @@ -3439,7 +3439,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_energetic_PBL) & call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL) - call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) + call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers) if (CS%debug_energy_req) & call diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS%diapyc_en_rec_CSp) @@ -3471,8 +3471,6 @@ subroutine diabatic_driver_end(CS) if (CS%debug_energy_req) & call diapyc_energy_req_end(CS%diapyc_en_rec_CSp) - deallocate(CS%regularize_layers_CSp) - if (CS%use_energetic_PBL) & call energetic_PBL_end(CS%energetic_PBL) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index af92e522a2..f42b1ae7ee 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -86,16 +86,13 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous - !! call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + ! Local variables integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& - "Module must be initialized before it is used.") - if (CS%regularize_surface_layers) then call pass_var(h, G%Domain, clock=id_clock_pass) call regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) @@ -123,8 +120,8 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous - !! call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & def_rat_u ! The ratio of the thickness deficit to the minimum depth [nondim]. @@ -194,9 +191,6 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& - "Module must be initialized before it is used.") - if (GV%nkml<1) return nkmb = GV%nk_rho_varies ; nkml = GV%nkml if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, & @@ -623,8 +617,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) real, dimension(SZI_(G),SZJB_(G)), & intent(out) :: def_rat_v !< The thickness deficit ratio at v points, !! [nondim]. - type(regularize_layers_CS), pointer :: CS !< The control structure returned by a - !! previous call to regularize_layers_init. + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -719,8 +712,8 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) !! run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate !! diagnostic output. - type(regularize_layers_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module. + type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control struct + #include "version_variable.h" character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. logical :: use_temperature @@ -729,12 +722,6 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (associated(CS)) then - call MOM_error(WARNING, "regularize_layers_init called with an associated"// & - "associated control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag CS%Time => Time From 5d0160a817771eeab012d9dcd30ef32f85d1f09d Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 16 Oct 2021 11:50:14 -0400 Subject: [PATCH 046/138] CVMix convection pointer removal * `CVMix_conv_CS` in diabatic driver renamed to `CVMix_conv` * Pointer instances of `CVMix_conv_CS` changed to locals * `CVMix_end` function removed, since it did nothing. --- .../vertical/MOM_CVMix_conv.F90 | 23 ++++--------------- .../vertical/MOM_diabatic_driver.F90 | 16 ++++++------- 2 files changed, 11 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 02edda1b51..6b44fce15e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -21,7 +21,7 @@ module MOM_CVMix_conv #include -public CVMix_conv_init, calculate_CVMix_conv, CVMix_conv_end, CVMix_conv_is_used +public CVMix_conv_init, calculate_CVMix_conv, CVMix_conv_is_used !> Control structure including parameters for CVMix convection. type, public :: CVMix_conv_cs ; private @@ -55,20 +55,14 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_conv_cs), pointer :: CS !< This module's control structure. - ! Local variables + type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convetction control struct + real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. logical :: useEPBL !< If True, use the ePBL boundary layer scheme. ! This include declares and sets the variable "version". #include "version_variable.h" - if (associated(CS)) then - call MOM_error(WARNING, "CVMix_conv_init called with an associated "// & - "control structure.") - return - endif - ! Read parameters call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & @@ -82,7 +76,6 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) default=.false.) if (.not. CVMix_conv_init) return - allocate(CS) call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, default=.false., & do_not_log=.true.) @@ -146,8 +139,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - type(CVMix_conv_cs), pointer :: CS !< The control structure returned - !! by a previous call to CVMix_conv_init. + type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control struct real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl !< Depth of ocean boundary layer [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: Kd !< Diapycnal diffusivity at each interface that @@ -305,11 +297,4 @@ logical function CVMix_conv_is_used(param_file) end function CVMix_conv_is_used -!> Clear pointers and dealocate memory -! NOTE: Placeholder destructor -subroutine CVMix_conv_end(CS) - type(CVMix_conv_cs), pointer :: CS !< Control structure for this module that - !! will be deallocated in this subroutine -end subroutine CVMix_conv_end - end module MOM_CVMix_conv diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 5b33ec5f95..9aa953ed06 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -23,7 +23,7 @@ module MOM_diabatic_driver use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs -use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv +use MOM_CVMix_conv, only : calculate_CVMix_conv use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init @@ -227,10 +227,10 @@ module MOM_diabatic_driver type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module type(optics_type), pointer :: optics => NULL() !< Control structure for a child module type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module - type(CVMix_conv_cs), pointer :: CVMix_conv_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct + type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control struct type(energetic_PBL_CS) :: energetic_PBL !< Energetic PBL control struct type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(geothermal_CS) :: geothermal !< Geothermal control struct @@ -723,7 +723,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_int, visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) endif ! This block sets ent_t and ent_s from h and Kd_int. @@ -1276,9 +1276,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection if (CS%useKPP) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) else - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_heat, visc%Kv_slow, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_slow, Kd_aux=Kd_salt) endif endif @@ -1866,7 +1866,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_CSp, Hml, Kd_int, visc%Kv_slow) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_slow) endif if (CS%useKPP) then @@ -3386,7 +3386,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise it is False. - CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv_CSp) + CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv) call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive, & just_read_params=CS%useALEalgorithm) @@ -3483,8 +3483,6 @@ subroutine diabatic_driver_end(CS) if (CS%use_geothermal) & call geothermal_end(CS%geothermal) - if (CS%use_CVMix_conv) deallocate(CS%CVMix_conv_CSp) - if (CS%useKPP) then deallocate( CS%KPP_buoy_flux ) deallocate( CS%KPP_temp_flux ) From 65a351631284af6b6ca44f00b56f3276c0cdd50b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 18 Oct 2021 13:29:10 -0400 Subject: [PATCH 047/138] MEKE_type pointer removal * `MEKE_type` pointers of many arguments and control structures changed from pointers to locals * `MEKE` input removed from the following: * `initialize_dyn_unsplit` * `initialize_dyn_unsplit_RK2` * Many `associated(MEKE)` checks have been removed, and now rely on associations of individual components within MEKE This is just "passing the buck" and not solving the underlying issue of decision-by-allocation, but it's closer to a true solution. * Pointer fields inside `MEKE_type` converted to allocatables `associated()` tests for them replaced with `allocatable()` --- src/core/MOM.F90 | 12 +- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 5 +- src/parameterizations/lateral/MOM_MEKE.F90 | 113 ++++++++---------- .../lateral/MOM_MEKE_types.F90 | 31 ++--- .../lateral/MOM_hor_visc.F90 | 35 +++--- .../lateral/MOM_thickness_diffuse.F90 | 36 +++--- src/tracer/MOM_tracer_hor_diff.F90 | 6 +- 9 files changed, 109 insertions(+), 139 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 98e94c0592..c4cbcf3960 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -227,8 +227,7 @@ module MOM type(diag_ctrl) :: diag !< structure to regulate diagnostic output timing type(vertvisc_type) :: visc !< structure containing vertical viscosities, !! bottom drag viscosities, and related fields - type(MEKE_type), pointer :: MEKE => NULL() !< structure containing fields - !! related to the Mesoscale Eddy Kinetic Energy + type(MEKE_type) :: MEKE !< Fields related to the Mesoscale Eddy Kinetic Energy logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time @@ -2663,13 +2662,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) else call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) endif @@ -3622,10 +3621,7 @@ subroutine MOM_end(CS) if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) - if (associated(CS%MEKE)) then - call MEKE_end(CS%MEKE) - deallocate(CS%MEKE) - endif + call MEKE_end(CS%MEKE) if (associated(CS%tv%internal_heat)) deallocate(CS%tv%internal_heat) if (associated(CS%tv%TempxPmE)) deallocate(CS%tv%TempxPmE) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 14741dbbd1..f5af5bb8ae 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -289,7 +289,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities - type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing @@ -1258,7 +1258,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass !! diagnostic pointers type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities - type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 5f525596b5..e8627b7735 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -218,8 +218,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! initialize_dyn_unsplit. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields !! that specify the spatially variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing - !! fields related to the Mesoscale Eddy Kinetic Energy. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions @@ -551,7 +550,7 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & + restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -581,7 +580,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. - type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions are !! used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 42efec91f9..9ea0300f0e 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -230,7 +230,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with !! fields that specify the spatially !! variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! fields related to the Mesoscale !! Eddy Kinetic Energy. ! Local variables @@ -499,7 +499,7 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & + restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -526,7 +526,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. - type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions !! are used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 5b58280277..551caa625e 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -112,7 +112,7 @@ module MOM_MEKE !> Integrates forward-in-time the MEKE eddy energy equation. !! See \ref section_MEKE_equations. subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, hv) - type(MEKE_type), pointer :: MEKE !< MEKE data. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -175,9 +175,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not.associated(MEKE)) call MOM_error(FATAL, & - "MOM_MEKE: MEKE must be initialized before it is used.") - if ((CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) .or. CS%visc_drag) then use_drag_rate = .true. else @@ -185,19 +182,20 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! Only integrate the MEKE equations if MEKE is required. - if (.not.associated(MEKE%MEKE)) then + if (.not. allocated(MEKE%MEKE)) then ! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") return endif if (CS%debug) then - if (associated(MEKE%mom_src)) & + if (allocated(MEKE%mom_src)) & call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%GME_snk)) & + if (allocated(MEKE%GME_snk)) & call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%GM_src)) & + if (allocated(MEKE%GM_src)) & call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) + if (allocated(MEKE%MEKE)) & + call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T, & scalar_pair=.true.) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, & @@ -323,21 +321,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h src(i,j) = CS%MEKE_BGsrc enddo ; enddo - if (associated(MEKE%mom_src)) then + if (allocated(MEKE%mom_src)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*MEKE%mom_src(i,j) enddo ; enddo endif - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) enddo ; enddo endif - if (associated(MEKE%GM_src)) then + if (allocated(MEKE%GM_src)) then if (CS%GM_src_alt) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie @@ -471,10 +469,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_here = max(0., CS%MEKE_Kh) + & CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) - if (associated(MEKE%Kh_diff)) & + if (allocated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + & CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -489,9 +487,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) - if (associated(MEKE%Kh_diff)) & + if (allocated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j),G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -612,7 +610,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif - if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) then + if (allocated(MEKE%Kh) .or. allocated(MEKE%Ku) .or. allocated(MEKE%Au)) then call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Kh, G%Domain) call cpu_clock_end(CS%id_clock_pass) @@ -674,7 +672,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), intent(in) :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution @@ -871,7 +869,7 @@ end subroutine MEKE_equilibrium_restoring subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & bottomFac2, barotrFac2, LmixScale) type(MEKE_CS), intent(in) :: CS !< MEKE control structure. - type(MEKE_type), intent(in) :: MEKE !< MEKE data. + type(MEKE_type), intent(in) :: MEKE !< MEKE field type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1023,7 +1021,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE-related fields. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables @@ -1051,13 +1049,6 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) default=.false.) if (.not. MEKE_init) return - if (.not. associated(MEKE)) then - ! The MEKE structure should have been allocated in MEKE_alloc_register_restart() - call MOM_error(WARNING, "MEKE_init called with NO associated "// & - "MEKE-type structure.") - return - endif - call MOM_mesg("MEKE_init: reading parameters ", 5) ! Read all relevant parameters and write them to the model log. @@ -1258,25 +1249,25 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & 'Mesoscale Eddy Kinetic Energy', 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (.not. associated(MEKE%MEKE)) CS%id_MEKE = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_MEKE = -1 CS%id_Kh = register_diag_field('ocean_model', 'MEKE_KH', diag%axesT1, Time, & 'MEKE derived diffusivity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (.not. associated(MEKE%Kh)) CS%id_Kh = -1 + if (.not. allocated(MEKE%Kh)) CS%id_Kh = -1 CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 + if (.not. allocated(MEKE%Ku)) CS%id_Ku = -1 CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) - if (.not. associated(MEKE%Au)) CS%id_Au = -1 + if (.not. allocated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & 'MEKE derived eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ue = -1 CS%id_Ub = register_diag_field('ocean_model', 'MEKE_Ub', diag%axesT1, Time, & 'MEKE derived bottom eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ub = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ub = -1 CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & 'MEKE derived barotropic eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) - if (.not. associated(MEKE%MEKE)) CS%id_Ut = -1 + if (.not. allocated(MEKE%MEKE)) CS%id_Ut = -1 CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3', conversion=(US%L_T_to_m_s**2)*US%s_to_T) CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & @@ -1284,15 +1275,15 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & 'MEKE energy available from thickness mixing', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 + if (.not. allocated(MEKE%GM_src)) CS%id_GM_src = -1 CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & 'MEKE energy available from momentum', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 + if (.not. allocated(MEKE%mom_src)) CS%id_mom_src = -1 CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & 'MEKE energy lost to GME backscatter', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) - if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 + if (.not. allocated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & @@ -1336,31 +1327,31 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) L_rescale = US%m_to_L / US%m_to_L_restart if (L_rescale*I_T_rescale /= 1.0) then - if (associated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then + if (allocated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = L_rescale*I_T_rescale * MEKE%MEKE(i,j) enddo ; enddo endif ; endif endif if (L_rescale**2*I_T_rescale /= 1.0) then - if (associated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then + if (allocated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Kh(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh(i,j) enddo ; enddo endif ; endif - if (associated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then + if (allocated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Ku(i,j) = L_rescale**2*I_T_rescale * MEKE%Ku(i,j) enddo ; enddo endif ; endif - if (associated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then + if (allocated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Kh_diff(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh_diff(i,j) enddo ; enddo endif ; endif endif if (L_rescale**4*I_T_rescale /= 1.0) then - if (associated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then + if (allocated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then do j=js,je ; do i=is,ie MEKE%Au(i,j) = L_rescale**4*I_T_rescale * MEKE%Au(i,j) enddo ; enddo @@ -1368,16 +1359,16 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) endif ! Set up group passes. In the case of a restart, these fields need a halo update now. - if (associated(MEKE%MEKE)) then + if (allocated(MEKE%MEKE)) then call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) - if (associated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) + if (allocated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) if (.not.CS%initialize) call do_group_pass(CS%pass_MEKE, G%Domain) endif - if (associated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) - if (associated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) - if (associated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) + if (allocated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + if (allocated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) + if (allocated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) - if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) & + if (allocated(MEKE%Kh) .or. allocated(MEKE%Ku) .or. allocated(MEKE%Au)) & call do_group_pass(CS%pass_Kh, G%Domain) end function MEKE_init @@ -1387,7 +1378,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. - type(MEKE_type), pointer :: MEKE !< A structure with MEKE-related fields. + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. ! Local variables type(vardesc) :: vd @@ -1407,12 +1398,6 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) MEKE_viscCoeff_Ku =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_KU",MEKE_viscCoeff_Ku) MEKE_viscCoeff_Au =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF_AU",MEKE_viscCoeff_Au) Use_KH_in_MEKE = .false.; call read_param(param_file,"USE_KH_IN_MEKE", Use_KH_in_MEKE) -! Allocate control structure - if (associated(MEKE)) then - call MOM_error(WARNING, "MEKE_alloc_register_restart called with an associated "// & - "MEKE type.") - return - else; allocate(MEKE); endif if (.not. useMEKE) return @@ -1464,15 +1449,15 @@ subroutine MEKE_end(MEKE) ! So these must all be conditional, even though MEKE%MEKE and MEKE%Rd_dx_h ! are always allocated (when MEKE is enabled) - if (associated(MEKE%Au)) deallocate(MEKE%Au) - if (associated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) - if (associated(MEKE%Ku)) deallocate(MEKE%Ku) - if (associated(MEKE%Rd_dx_h)) deallocate(MEKE%Rd_dx_h) - if (associated(MEKE%Kh)) deallocate(MEKE%Kh) - if (associated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) - if (associated(MEKE%mom_src)) deallocate(MEKE%mom_src) - if (associated(MEKE%GM_src)) deallocate(MEKE%GM_src) - if (associated(MEKE%MEKE)) deallocate(MEKE%MEKE) + if (allocated(MEKE%Au)) deallocate(MEKE%Au) + if (allocated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) + if (allocated(MEKE%Ku)) deallocate(MEKE%Ku) + if (allocated(MEKE%Rd_dx_h)) deallocate(MEKE%Rd_dx_h) + if (allocated(MEKE%Kh)) deallocate(MEKE%Kh) + if (allocated(MEKE%GME_snk)) deallocate(MEKE%GME_snk) + if (allocated(MEKE%mom_src)) deallocate(MEKE%mom_src) + if (allocated(MEKE%GM_src)) deallocate(MEKE%GM_src) + if (allocated(MEKE%MEKE)) deallocate(MEKE%MEKE) end subroutine MEKE_end !> \namespace mom_meke diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 01a602157a..57de7c0b02 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -7,21 +7,22 @@ module MOM_MEKE_types !> This type is used to exchange information related to the MEKE calculations. type, public :: MEKE_type ! Variables - real, dimension(:,:), pointer :: & - MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [R Z L2 T-3 ~> W m-2]. - mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [R Z L2 T-3 ~> W m-2]. - GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [R Z L2 T-3 ~> W m-2]. - Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. - Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse - !! MEKE [L2 T-1 ~> m2 s-1]. - Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing [nondim]. - !! Rd_dx_h is copied from VarMix_CS. - real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient - !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing - !! backscatter from unresolved eddies (see Jansen and Held, 2014). - real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity - !! coefficient [L4 T-1 ~> m4 s-1]. + real, allocatable :: MEKE(:,:) !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. + real, allocatable :: GM_src(:,:) !< MEKE source due to thickness mixing (GM) [R Z L2 T-3 ~> W m-2]. + real, allocatable :: mom_src(:,:) !< MEKE source from lateral friction in the + !! momentum equations [R Z L2 T-3 ~> W m-2]. + real, allocatable :: GME_snk(:,:) !< MEKE sink from GME backscatter in the momentum equations [R Z L2 T-3 ~> W m-2]. + real, allocatable :: Kh(:,:) !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. + real, allocatable :: Kh_diff(:,:) !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse + !! MEKE [L2 T-1 ~> m2 s-1]. + real, allocatable :: Rd_dx_h(:,:) !< The deformation radius compared with the grid spacing [nondim]. + !! Rd_dx_h is copied from VarMix_CS. + real, allocatable :: Ku(:,:) !< The MEKE-derived lateral viscosity coefficient + !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! backscatter from unresolved eddies (see Jansen and Held, 2014). + real, allocatable :: Au(:,:) !< The MEKE-derived lateral biharmonic viscosity + !! coefficient [L4 T-1 ~> m4 s-1]. + ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0b733514a7..0e0fa789d2 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -233,7 +233,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: diffv !< Meridional acceleration due to convergence !! of along-coordinate stress tensor [L T-2 ~> m s-2]. - type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities @@ -420,21 +420,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, find_FrictWork = (CS%id_FrictWork > 0) if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. - if (associated(MEKE)) then - if (associated(MEKE%mom_src)) find_FrictWork = .true. - backscat_subround = 0.0 - if (find_FrictWork .and. associated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & - (MEKE%backscatter_Ro_Pow /= 0.0)) & - backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) - endif + + if (allocated(MEKE%mom_src)) find_FrictWork = .true. + backscat_subround = 0.0 + if (find_FrictWork .and. allocated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & + (MEKE%backscatter_Ro_Pow /= 0.0)) & + backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) ! Toggle whether to use a Laplacian viscosity derived from MEKE - if (associated(MEKE)) then - use_MEKE_Ku = associated(MEKE%Ku) - use_MEKE_Au = associated(MEKE%Au) - else - use_MEKE_Ku = .false. ; use_MEKE_Au = .false. - endif + use_MEKE_Ku = allocated(MEKE%Ku) + use_MEKE_Au = allocated(MEKE%Au) rescale_Kh = .false. if (associated(VarMix)) then @@ -1468,7 +1463,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif enddo ; enddo - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) enddo ; enddo @@ -1557,12 +1552,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Make a similar calculation as for FrictWork above but accumulating into ! the vertically integrated MEKE source term, and adjusting for any ! energy loss seen as a reduction in the (biharmonic) frictional source term. - if (find_FrictWork .and. associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + if (find_FrictWork .and. allocated(MEKE%mom_src)) then if (k==1) then do j=js,je ; do i=is,ie MEKE%mom_src(i,j) = 0. enddo ; enddo - if (associated(MEKE%GME_snk)) then + if (allocated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie MEKE%GME_snk(i,j) = 0. enddo ; enddo @@ -1615,13 +1610,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork(i,j,k) enddo ; enddo - if (CS%use_GME .and. associated(MEKE)) then ; if (associated(MEKE%GME_snk)) then + if (CS%use_GME .and. allocated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) enddo ; enddo - endif ; endif + endif - endif ; endif ! find_FrictWork and associated(mom_src) + endif ! find_FrictWork and associated(mom_src) enddo ! end of k loop diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c68558a647..8106d3d130 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -115,7 +115,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE control structure + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion @@ -160,16 +160,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] - if ((.not.CS%thickness_diffuse) .or. & - .not.( CS%Khth > 0.0 .or. associated(VarMix) .or. associated(MEKE) ) ) return + if ((.not.CS%thickness_diffuse) .or. .not.(CS%Khth > 0.0 .or. associated(VarMix))) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff - if (associated(MEKE)) then - if (associated(MEKE%GM_src)) then - do j=js,je ; do i=is,ie ; MEKE%GM_src(i,j) = 0. ; enddo ; enddo - endif + if (allocated(MEKE%GM_src)) then + do j=js,je ; do i=is,ie ; MEKE%GM_src(i,j) = 0. ; enddo ; enddo endif use_VarMix = .false. ; Resoln_scaled = .false. ; use_stored_slopes = .false. @@ -225,7 +222,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then !$OMP do do j=js,je ; do I=is-1,ie @@ -238,7 +235,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp Khth_loc_u(I,j) = Khth_loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif - endif ; endif + endif if (Resoln_scaled) then !$OMP do @@ -311,7 +308,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo endif endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then !$OMP do do J=js-1,je ; do i=is,ie @@ -324,7 +321,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp Khth_loc_v(i,J) = Khth_loc_v(i,J) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif - endif ; endif + endif if (Resoln_scaled) then !$OMP do @@ -387,7 +384,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ; enddo endif - if (associated(MEKE)) then ; if (associated(MEKE%Kh)) then + if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then if (CS%MEKE_GEOM_answers_2018) then !$OMP do @@ -409,7 +406,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo endif endif - endif ; endif + endif !$OMP do @@ -448,8 +445,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp int_slope_u, int_slope_v) endif - if (associated(MEKE) .AND. associated(VarMix)) then - if (associated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then + if (associated(VarMix)) then + if (allocated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then !$OMP parallel do default(none) shared(is,ie,js,je,MEKE,VarMix) do j=js,je ; do i=is,ie MEKE%Rd_dx_h(i,j) = VarMix%Rd_dx_h(i,j) @@ -574,7 +571,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] real, intent(in) :: dt !< Time increment [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE control structure + type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from @@ -721,8 +718,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV hN2_x_PE(:,:,:) = 0.0 hN2_y_PE(:,:,:) = 0.0 - find_work = .false. - if (associated(MEKE)) find_work = associated(MEKE%GM_src) + find_work = allocated(MEKE%GM_src) find_work = (allocated(CS%GMwork) .or. find_work) if (use_EOS) then @@ -1408,12 +1404,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) if (allocated(CS%GMwork)) CS%GMwork(i,j) = Work_h - if (associated(MEKE) .and. .not.CS%GM_src_alt) then ; if (associated(MEKE%GM_src)) then + if (.not. CS%GM_src_alt) then ; if (allocated(MEKE%GM_src)) then MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h endif ; endif enddo ; enddo ; endif - if (find_work .and. CS%GM_src_alt .and. associated(MEKE)) then ; if (associated(MEKE%GM_src)) then + if (find_work .and. CS%GM_src_alt) then ; if (allocated(MEKE%GM_src)) then do j=js,je ; do i=is,ie ; do k=nz,1,-1 PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index eb59dcc74f..a5d07a6c23 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -109,7 +109,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] - type(MEKE_type), pointer :: MEKE !< MEKE type + type(MEKE_type), intent(in) :: MEKE !< MEKE fields type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure @@ -219,7 +219,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & @@ -236,7 +236,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) - if (associated(MEKE%Kh)) & + if (allocated(MEKE%Kh)) & Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & From 1cef96cd9e09bbfadd78b2ca0628047fa035dce1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 19 Oct 2021 08:34:36 -0400 Subject: [PATCH 048/138] Variable mixing pointer removal * `VarMix_CS` pointer instances redefined as locals * `associated(VarMix)` tests replaced with `VarMix%use_variable_mixing`. This ought to be identical, since `VarMix_init()` deallocates the CS if this flag is unset (False), and the function is always called. * VarMix arrays changed from pointers to allocatables --- src/core/MOM.F90 | 19 +- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_dynamics_unsplit.F90 | 3 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 +- .../lateral/MOM_hor_visc.F90 | 9 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 174 ++++++++---------- .../lateral/MOM_mixed_layer_restrat.F90 | 7 +- .../lateral/MOM_thickness_diffuse.F90 | 13 +- src/tracer/MOM_tracer_hor_diff.F90 | 6 +- 9 files changed, 105 insertions(+), 134 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c4cbcf3960..1adcbec3aa 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -357,8 +357,8 @@ module MOM !< Pointer to the control structure for the diabatic driver type(MEKE_CS) :: MEKE_CSp !< Pointer to the control structure for the MEKE updates - type(VarMix_CS), pointer :: VarMix => NULL() - !< Pointer to the control structure for the variable mixing module + type(VarMix_CS) :: VarMix + !< Control structure for the variable mixing module type(Barotropic_CS), pointer :: Barotropic_CSp => NULL() !< Pointer to the control structure for the barotropic module type(tracer_registry_type), pointer :: tracer_Reg => NULL() @@ -636,7 +636,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS CS%time_in_cycle = 0.0 do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call enable_averages(cycle_time, Time_start + real_to_time(US%T_to_s*cycle_time), CS%diag) call calc_resoln_function(h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) @@ -1032,7 +1032,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call enable_averages(dt_thermo, Time_local+real_to_time(US%T_to_s*(dt_thermo-dt)), CS%diag) call cpu_clock_begin(id_clock_thick_diff) - if (associated(CS%VarMix)) & + if (CS%VarMix%use_variable_mixing) & call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) @@ -1111,7 +1111,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) - if (associated(CS%VarMix)) & + if (CS%VarMix%use_variable_mixing) & call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) @@ -1562,7 +1562,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Perform offline diffusion if requested if (.not. skip_diffusion) then - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) @@ -1588,7 +1588,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - if (associated(CS%VarMix)) then + if (CS%VarMix%use_variable_mixing) then call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) @@ -3613,10 +3613,7 @@ subroutine MOM_end(CS) call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) - if (associated(CS%VarMix)) then - call VarMix_end(CS%VarMix) - deallocate(CS%VarMix) - endif + call VarMix_end(CS%VarMix) if (associated(CS%set_visc_CSp)) & call set_visc_end(CS%visc, CS%set_visc_CSp) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f5af5bb8ae..ded91709f6 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -288,7 +288,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s !! averaged over time step [H ~> m or kg m-2] type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities @@ -1257,7 +1257,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass !! diagnostic pointers - type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities + type(VarMix_CS), intent(inout) :: VarMix !< points to spatially variable viscosities type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure !! used for the isopycnal height diffusive transport. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index e8627b7735..1d1a2b11b8 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -216,8 +216,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields - !! that specify the spatially variable viscosities. + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 9ea0300f0e..554c6fb2ed 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -227,9 +227,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with - !! fields that specify the spatially - !! variable viscosities. + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! fields related to the Mesoscale !! Eddy Kinetic Energy. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0e0fa789d2..d4ba595de3 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -235,8 +235,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !! of along-coordinate stress tensor [L T-2 ~> m s-2]. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! related to Mesoscale Eddy Kinetic Energy. - type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that - !! specify the spatially variable viscosities + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control struct type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type @@ -432,10 +431,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, use_MEKE_Au = allocated(MEKE%Au) rescale_Kh = .false. - if (associated(VarMix)) then + if (VarMix%use_variable_mixing) then rescale_Kh = VarMix%Resoln_scaled_Kh - if ((rescale_Kh .or. CS%res_scale_MEKE) .and. & - (.not.associated(VarMix%Res_fn_h) .or. .not.associated(VarMix%Res_fn_q))) & + if ((rescale_Kh .or. CS%res_scale_MEKE) & + .and. (.not. allocated(VarMix%Res_fn_h) .or. .not. allocated(VarMix%Res_fn_q))) & call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and VarMix%Res_fn_q "//& "both need to be associated with Resoln_scaled_Kh or RES_SCALE_MEKE_VISC.") elseif (CS%res_scale_MEKE) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9306233112..9a0e0c86ea 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -63,46 +63,46 @@ module MOM_lateral_mixing_coeffs !! This parameter is set depending on other parameters. real :: cropping_distance !< Distance from surface or bottom to filter out outcropped or !! incropped interfaces for the Eady growth rate calc [Z ~> m] - real, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points [T-1 ~> s-1] - SN_v => NULL(), & !< S*N at v-points [T-1 ~> s-1] - L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] - L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> m2] - cg1 => NULL(), & !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. - Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at h points [nondim]. - Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at q points [nondim]. - Res_fn_u => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at u points [nondim]. - Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at v points [nondim]. - Depth_fn_u => NULL(), & !< Non-dimensional function of the ratio of the depth to - !! a reference depth (maximum 1) at u points [nondim] - Depth_fn_v => NULL(), & !< Non-dimensional function of the ratio of the depth to - !! a reference depth (maximum 1) at v points [nondim] - beta_dx2_h => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at h points [L T-1 ~> m s-1]. - beta_dx2_q => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at q points [L T-1 ~> m s-1]. - beta_dx2_u => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at u points [L T-1 ~> m s-1]. - beta_dx2_v => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at v points [L T-1 ~> m s-1]. - f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h [L2 T-2 ~> m2 s-2]. - f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q [L2 T-2 ~> m2 s-2]. - f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u [L2 T-2 ~> m2 s-2]. - f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v [L2 T-2 ~> m2 s-2]. - Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] - - real, dimension(:,:,:), pointer :: & - slope_x => NULL(), & !< Zonal isopycnal slope [nondim] - slope_y => NULL(), & !< Meridional isopycnal slope [nondim] - ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] + + real, allocatable :: SN_u(:,:) !< S*N at u-points [T-1 ~> s-1] + real, allocatable :: SN_v(:,:) !< S*N at v-points [T-1 ~> s-1] + real, allocatable :: L2u(:,:) !< Length scale^2 at u-points [L2 ~> m2] + real, allocatable :: L2v(:,:) !< Length scale^2 at v-points [L2 ~> m2] + real, allocatable :: cg1(:,:) !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. + real, allocatable :: Res_fn_h(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at h points [nondim]. + real, allocatable :: Res_fn_q(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at q points [nondim]. + real, allocatable :: Res_fn_u(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at u points [nondim]. + real, allocatable :: Res_fn_v(:,:) !< Non-dimensional function of the ratio the first baroclinic + !! deformation radius to the grid spacing at v points [nondim]. + real, allocatable :: Depth_fn_u(:,:) !< Non-dimensional function of the ratio of the depth to + !! a reference depth (maximum 1) at u points [nondim] + real, allocatable :: Depth_fn_v(:,:) !< Non-dimensional function of the ratio of the depth to + !! a reference depth (maximum 1) at v points [nondim] + real, allocatable :: beta_dx2_h(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at h points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_q(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at q points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_u(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at u points [L T-1 ~> m s-1]. + real, allocatable :: beta_dx2_v(:,:) !< The magnitude of the gradient of the Coriolis parameter + !! times the grid spacing squared at v points [L T-1 ~> m s-1]. + real, allocatable :: f2_dx2_h(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at h [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_q(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at q [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_u(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at u [L2 T-2 ~> m2 s-2]. + real, allocatable :: f2_dx2_v(:,:) !< The Coriolis parameter squared times the grid + !! spacing squared at v [L2 T-2 ~> m2 s-2]. + real, allocatable :: Rd_dx_h(:,:) !< Deformation radius over grid spacing [nondim] + + real, allocatable :: slope_x(:,:,:) !< Zonal isopycnal slope [nondim] + real, allocatable :: slope_y(:,:,:) !< Meridional isopycnal slope [nondim] + real, allocatable :: ebt_struct(:,:,:) !< Vertical structure function to scale diffusivities with [nondim] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] @@ -164,8 +164,8 @@ module MOM_lateral_mixing_coeffs !> Calculates the non-dimensional depth functions. subroutine calc_depth_function(G, CS) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct ! Local variables integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -175,12 +175,10 @@ subroutine calc_depth_function(G, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not. associated(CS)) call MOM_error(FATAL, "calc_depth_function:"// & - "Module must be initialized before it is used.") if (.not. CS%calculate_depth_fns) return - if (.not. associated(CS%Depth_fn_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%Depth_fn_u)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_u is not associated with Depth_scaled_KhTh.") - if (.not. associated(CS%Depth_fn_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%Depth_fn_v)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_v is not associated with Depth_scaled_KhTh.") H0 = CS%depth_scaled_khth_h0 @@ -203,7 +201,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some @@ -218,13 +216,11 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not. associated(CS)) call MOM_error(FATAL, "calc_resoln_function:"// & - "Module must be initialized before it is used.") if (CS%calculate_cg1) then - if (.not. associated(CS%cg1)) call MOM_error(FATAL, & + if (.not. allocated(CS%cg1)) call MOM_error(FATAL, & "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") if (CS%khth_use_ebt_struct) then - if (.not. associated(CS%ebt_struct)) call MOM_error(FATAL, & + if (.not. allocated(CS%ebt_struct)) call MOM_error(FATAL, & "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then ! Both resolution fn and vertical structure are using EBT @@ -247,7 +243,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) ! Calculate and store the ratio between deformation radius and grid-spacing ! at h-points [nondim]. if (CS%calculate_rd_dx) then - if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -261,29 +257,29 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (.not. CS%calculate_res_fns) return - if (.not. associated(CS%Res_fn_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_h)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_q)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_u)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%Res_fn_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%Res_fn_v)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_v is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%f2_dx2_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%f2_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_v is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_h)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_q)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_u)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. associated(CS%beta_dx2_v)) call MOM_error(FATAL, & + if (.not. allocated(CS%beta_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_v is not associated with Resoln_scaled_Kh.") ! Do this calculation on the extent used in MOM_hor_visc.F90, and @@ -450,7 +446,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: dt !< Time increment [T ~> s] - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & @@ -462,9 +458,6 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)+1) :: dzSxN ! |Sx| N times dz at u-points [Z T-1 ~> m s-1] real, dimension(SZI_(G), SZJB_(G),SZK_(GV)+1) :: dzSyN ! |Sy| N times dz at v-points [Z T-1 ~> m s-1] - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& - "Module must be initialized before it is used.") - if (CS%calculate_Eady_growth_rate) then if (CS%use_simpler_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) @@ -514,7 +507,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency !! at v-points [L2 Z-2 T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables @@ -531,12 +524,10 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C real :: S2_v(SZI_(G), SZJB_(G)) logical :: local_open_u_BC, local_open_v_BC - if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & - "Module must be initialized before it is used.") if (.not. CS%calculate_Eady_growth_rate) return - if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -669,11 +660,11 @@ end subroutine calc_Visbeck_coeffs_old !> Calculates the Eady growth rate (2D fields) for use in MEKE and the Visbeck schemes subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, dzSyN, SN_u, SN_v) - type(VarMix_CS), intent(in) :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), pointer, intent(in) :: OBC !< Open boundaries control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Interface height [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface height [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzu !< dz at u-points [Z ~> m] @@ -855,7 +846,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface position [Z ~> m] logical, intent(in) :: calculate_slopes !< If true, calculate slopes !! internally otherwise use slopes stored in CS @@ -878,12 +869,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(GV)) logical :: local_open_u_BC, local_open_v_BC - if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & - "Module must be initialized before it is used.") if (.not. CS%calculate_Eady_growth_rate) return - if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1014,7 +1003,7 @@ end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1149,7 +1138,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when @@ -1179,13 +1168,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "VarMix_init called with an associated "// & - "control structure.") - return - endif - - allocate(CS) in_use = .false. ! Set to true to avoid deallocating CS%diag => diag ! Diagnostics pointer CS%calculate_cg1 = .false. @@ -1594,14 +1576,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "USE_STORED_SLOPES must be True when using QG Leith.") endif - ! If nothing is being stored in this class then deallocate - if (in_use) then - CS%use_variable_mixing = .true. - else - deallocate(CS) - return - endif - + ! Re-enable variable mixing if one of the schemes was enabled + CS%use_variable_mixing = in_use .or. CS%use_variable_mixing end subroutine VarMix_init !> Destructor for VarMix control structure @@ -1621,8 +1597,8 @@ subroutine VarMix_end(CS) deallocate(CS%SN_v) endif - if (associated(CS%L2u)) deallocate(CS%L2u) - if (associated(CS%L2v)) deallocate(CS%L2v) + if (allocated(CS%L2u)) deallocate(CS%L2u) + if (allocated(CS%L2v)) deallocate(CS%L2v) if (CS%Resoln_scaling_used) then deallocate(CS%Res_fn_h) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 7d84120f9c..9cfbf8f5f8 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -101,7 +101,7 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] - type(VarMix_CS), pointer :: VarMix !< Container for derived fields + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure if (GV%nkml>0) then @@ -128,7 +128,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] (not H) - type(VarMix_CS), pointer :: VarMix !< Container for derived fields + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -196,7 +196,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") - if (.not.associated(VarMix) .and. CS%front_length>0.) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & + call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "The resolution argument, Rd/dx, was not associated.") if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD. diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8106d3d130..7382459c16 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -116,7 +116,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients + type(VarMix_CS), target, intent(in) :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion ! Local variables @@ -160,7 +160,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] - if ((.not.CS%thickness_diffuse) .or. .not.(CS%Khth > 0.0 .or. associated(VarMix))) return + if ((.not.CS%thickness_diffuse) & + .or. .not. (CS%Khth > 0.0 .or. VarMix%use_variable_mixing)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff @@ -173,7 +174,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp khth_use_ebt_struct = .false. ; use_Visbeck = .false. ; use_QG_Leith = .false. Depth_scaled = .false. - if (associated(VarMix)) then + if (VarMix%use_variable_mixing) then use_VarMix = VarMix%use_variable_mixing .and. (CS%KHTH_Slope_Cff > 0.) Resoln_scaled = VarMix%Resoln_scaled_KhTh Depth_scaled = VarMix%Depth_scaled_KhTh @@ -181,7 +182,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp khth_use_ebt_struct = VarMix%khth_use_ebt_struct use_Visbeck = VarMix%use_Visbeck use_QG_Leith = VarMix%use_QG_Leith_GM - if (associated(VarMix%cg1)) cg1 => VarMix%cg1 + if (allocated(VarMix%cg1)) cg1 => VarMix%cg1 else cg1 => null() endif @@ -445,8 +446,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp int_slope_u, int_slope_v) endif - if (associated(VarMix)) then - if (allocated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then + if (VarMix%use_variable_mixing) then + if (allocated(MEKE%Rd_dx_h) .and. allocated(VarMix%Rd_dx_h)) then !$OMP parallel do default(none) shared(is,ie,js,je,MEKE,VarMix) do j=js,je ; do i=is,ie MEKE%Rd_dx_h(i,j) = VarMix%Rd_dx_h(i,j) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index a5d07a6c23..850480e3e6 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -110,7 +110,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] type(MEKE_type), intent(in) :: MEKE !< MEKE fields - type(VarMix_CS), pointer :: VarMix !< Variable mixing type + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers @@ -176,7 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online "register_tracer must be called before tracer_hordiff.") if (LOC(Reg)==0) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "register_tracer must be called before tracer_hordiff.") - if ((Reg%ntr==0) .or. ((CS%KhTr <= 0.0) .and. .not.associated(VarMix)) ) return + if (Reg%ntr == 0 .or. (CS%KhTr <= 0.0 .and. .not. VarMix%use_variable_mixing)) return if (CS%show_call_tree) call callTree_enter("tracer_hordiff(), MOM_tracer_hor_diff.F90") @@ -199,7 +199,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%debug) call MOM_tracer_chksum("Before tracer diffusion ", Reg%Tr, ntr, G) use_VarMix = .false. ; Resoln_scaled = .false. ; use_Eady = .false. - if (Associated(VarMix)) then + if (VarMix%use_variable_mixing) then use_VarMix = VarMix%use_variable_mixing Resoln_scaled = VarMix%Resoln_scaled_KhTr use_Eady = CS%KhTr_Slope_Cff > 0. From bbf0f5221d35f1e7088bec35b5bf16fa194f555a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 19 Oct 2021 11:49:20 -0400 Subject: [PATCH 049/138] Wave speed pointer removal * `wave_speed_CS` pointers redefined as locals * `wave_speed_CSp` in varmix and diagnostics renamed to `wave_speed` * `S` and `T` pointers removed wave speed update --- src/diagnostics/MOM_diagnostics.F90 | 13 +++---- src/diagnostics/MOM_wave_speed.F90 | 37 +++++-------------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 15 +++----- 3 files changed, 22 insertions(+), 43 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7817fc4959..becf9c842b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -148,8 +148,7 @@ module MOM_diagnostics integer :: id_drho_dT = -1, id_drho_dS = -1 integer :: id_h_pre_sync = -1 !>@} - !> The control structure for calculating wave speed. - type(wave_speed_CS), pointer :: wave_speed_CSp => NULL() + type(wave_speed_CS) :: wave_speed !< Wave speed control struct type(p3d) :: var_ptr(MAX_FIELDS_) !< pointers to variables used in the calculation !! of time derivatives @@ -735,7 +734,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0)) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) if (CS%id_cg1>0) call post_data(CS%id_cg1, CS%cg1, CS%diag) if (CS%id_Rd1>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) @@ -775,12 +774,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if ((CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then if (CS%id_p_ebt>0) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth, modal_structure=CS%p_ebt) call post_data(CS%id_p_ebt, CS%p_ebt, CS%diag) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth) endif @@ -1951,10 +1950,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0) .or. & (CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then - call wave_speed_init(CS%wave_speed_CSp, remap_answers_2018=remap_answers_2018, & + call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) -!### call wave_speed_init(CS%wave_speed_CSp, remap_answers_2018=remap_answers_2018) +!### call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018) call safe_alloc_ptr(CS%cg1,isd,ied,jsd,jed) if (CS%id_Rd1>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) if (CS%id_Rd_ebt>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 833e7d8165..acec868561 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -63,7 +63,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed [L T-1 ~> m s-1] - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent @@ -119,7 +119,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 L-2 ~> 1]. - real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant ! and its derivative with lam between rows of the Thomas algorithm solver. The @@ -147,8 +146,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_speed: "// & - "Module must be initialized before it is used.") if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif @@ -169,7 +166,6 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ enddo ; enddo ; enddo endif - S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 ! Simplifying the following could change answers at roundoff. Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) @@ -196,7 +192,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. min_h_frac = tol_Hfrac / real(nz) -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S,tv,& +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & !$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2, & @@ -229,12 +225,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ ! Start a new layer H_here(i) = h(i,j,k)*GV%H_to_Z - HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) else H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z - HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = HxT_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -640,7 +636,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] - type(wave_speed_CS), optional, pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), optional, intent(in) :: CS !< Wave speed control struct logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. @@ -726,11 +722,6 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (present(CS)) then - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_speed: "// & - "Module must be initialized before it is used.") - endif - if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif @@ -1171,7 +1162,7 @@ end subroutine tridiag_det !> Initialize control structure for MOM_wave_speed subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & better_speed_est, min_speed, wave_speed_tol) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), intent(inout) :: CS !< Wave speed control struct logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over @@ -1194,12 +1185,6 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de # include "version_variable.h" character(len=40) :: mdl = "MOM_wave_speed" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "wave_speed_init called with an "// & - "associated control structure.") - return - else ; allocate(CS) ; endif - ! Write all relevant parameters to the model log. call log_version(mdl, version) @@ -1214,7 +1199,8 @@ end subroutine wave_speed_init !> Sets internal parameters for MOM_wave_speed subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & better_speed_est, min_speed, wave_speed_tol) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + type(wave_speed_CS), intent(inout) :: CS + !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over @@ -1233,9 +1219,6 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the !! wave speeds [nondim] - if (.not.associated(CS)) call MOM_error(FATAL, & - "wave_speed_set_param called with an associated control structure.") - if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9a0e0c86ea..5902f98b56 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -152,7 +152,7 @@ module MOM_lateral_mixing_coeffs !! timing of diagnostic output. !>@} - type(wave_speed_CS), pointer :: wave_speed_CSp => NULL() !< Wave speed control structure + type(wave_speed_CS) :: wave_speed !< Wave speed control structure type(group_pass_type) :: pass_cg1 !< For group halo pass logical :: debug !< If true, write out checksums of data for debugging end type VarMix_CS @@ -224,16 +224,16 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then ! Both resolution fn and vertical structure are using EBT - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, modal_structure=CS%ebt_struct) else ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, modal_structure=CS%ebt_struct, & use_ebt_mode=.true.) - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) endif call pass_var(CS%ebt_struct, G%Domain) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) endif call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) @@ -1527,7 +1527,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, & "If true, use a more robust estimate of the first mode wave speed as the "//& "starting point for iterations.", default=.true.) - call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, & + call wave_speed_init(CS%wave_speed, use_ebt_mode=CS%Resoln_use_ebt, & mono_N2_depth=N2_filter_depth, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) @@ -1634,9 +1634,6 @@ subroutine VarMix_end(CS) DEALLOC_(CS%KH_u_QG) DEALLOC_(CS%KH_v_QG) endif - - if (CS%calculate_cg1) deallocate(CS%wave_speed_CSp) - end subroutine VarMix_end !> \namespace mom_lateral_mixing_coeffs From 7a631304f512d29153d799642f25ce38c6daad2d Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 20 Oct 2021 12:24:06 -0400 Subject: [PATCH 050/138] MOM_restart_cs pointer removal * Most `MOM_restart_CS` instances changed from pointers to locals * `MOM_restart_CS` removed from unsplit dyncore subroutines * `restart_CSp` renamed to `restart_CS` in many functions --- src/core/MOM.F90 | 8 +- src/core/MOM_barotropic.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_dynamics_unsplit.F90 | 10 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +- src/core/MOM_open_boundary.F90 | 38 ++--- src/framework/MOM_restart.F90 | 161 +++++------------- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 2 +- .../MOM_state_initialization.F90 | 8 +- src/ocean_data_assim/MOM_oda_incupd.F90 | 39 ++--- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../vertical/MOM_set_viscosity.F90 | 4 +- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_CFC_cap.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/MOM_tracer_registry.F90 | 9 +- src/tracer/RGC_tracer.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/nw2_tracers.F90 | 2 +- src/tracer/oil_tracer.F90 | 2 +- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 2 +- 32 files changed, 118 insertions(+), 223 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1adcbec3aa..e1927da1f0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2350,10 +2350,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%dyn_split_RK2_CSp, restart_CSp, CS%uh, CS%vh) elseif (CS%use_RK2) then call register_restarts_dyn_unsplit_RK2(HI, GV, param_file, & - CS%dyn_unsplit_RK2_CSp, restart_CSp) + CS%dyn_unsplit_RK2_CSp) else call register_restarts_dyn_unsplit(HI, GV, param_file, & - CS%dyn_unsplit_CSp, restart_CSp) + CS%dyn_unsplit_CSp) endif ! This subroutine calls user-specified tracer registration routines. @@ -2661,13 +2661,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & - param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & + param_file, diag, CS%dyn_unsplit_RK2_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) else call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & - param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & + param_file, diag, CS%dyn_unsplit_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc, cont_stencil=CS%cont_stencil) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index cf52bd3a89..6a64b84234 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4253,7 +4253,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, !! output. type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set in register_barotropic_restarts. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must !! be recalculated before stepping. type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the @@ -5013,7 +5013,7 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) type(barotropic_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd(3) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index ded91709f6..9961f712d9 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1160,7 +1160,7 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & @@ -1250,7 +1250,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(param_file_type), intent(in) :: param_file !< parameter file for parsing type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct real, intent(in) :: dt !< time step [T ~> s] type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for !! budget analysis diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 1d1a2b11b8..6e2dfaad31 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -67,8 +67,6 @@ module MOM_dynamics_unsplit use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, MOM_restart_CS use MOM_time_manager, only : time_type, real_to_time, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -509,16 +507,14 @@ end subroutine step_MOM_dyn_unsplit !! !! All variables registered here should have the ability to be recreated if they are not present !! in a restart file. -subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) +subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - ! Local arguments character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name. character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB @@ -549,7 +545,7 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -568,8 +564,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS !! regulate diagnostic output. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up !! by initialize_dyn_unsplit. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the various !! accelerations in the momentum equations, which can be used !! for later derived diagnostics, like energy budgets. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 554c6fb2ed..4cbedafd6f 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -66,8 +66,6 @@ module MOM_dynamics_unsplit_RK2 use MOM_error_handler, only : MOM_set_verbosity use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, MOM_restart_CS use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -454,15 +452,13 @@ end subroutine step_MOM_dyn_unsplit_RK2 !! !! All variables registered here should have the ability to be recreated if they are not present !! in a restart file. -subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS) +subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. ! This subroutine sets up any auxiliary restart variables that are specific ! to the unsplit time stepping scheme. All variables registered here should ! have the ability to be recreated if they are not present in a restart file. @@ -497,7 +493,7 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -513,8 +509,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag !! regulate diagnostic output. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up !! by initialize_dyn_unsplit_RK2. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart - !! control structure. type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the !! various accelerations in the momentum equations, which can !! be used for later derived diagnostics, like energy budgets. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 1601d6dd56..ed885b9574 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1786,13 +1786,13 @@ end subroutine parse_segment_param_real !> Initialize open boundary control structure and do any necessary rescaling of OBC !! fields that have been read from a restart file. -subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) +subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Container for vertical grid information type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) + type(MOM_restart_CS), intent(in) :: restart_CS !< Restart structure, data intent(inout) ! Local variables real :: vel2_rescale ! A rescaling factor for squared velocities from the representation in @@ -1830,12 +1830,12 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) ! if ( OBC%radiation_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & ! ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then ! vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) -! if (query_initialized(OBC%rx_normal, "rx_normal", restart_CSp)) then +! if (query_initialized(OBC%rx_normal, "rx_normal", restart_CS)) then ! do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ! OBC%rx_normal(I,j,k) = vel_rescale * OBC%rx_normal(I,j,k) ! enddo ; enddo ; enddo ! endif -! if (query_initialized(OBC%ry_normal, "ry_normal", restart_CSp)) then +! if (query_initialized(OBC%ry_normal, "ry_normal", restart_CS)) then ! do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ! OBC%ry_normal(i,J,k) = vel_rescale * OBC%ry_normal(i,J,k) ! enddo ; enddo ; enddo @@ -1846,17 +1846,17 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) if ( OBC%oblique_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then vel2_rescale = (US%m_to_L * US%s_to_T_restart)**2 / (US%m_to_L_restart * US%s_to_T)**2 - if (query_initialized(OBC%rx_oblique, "rx_oblique", restart_CSp)) then + if (query_initialized(OBC%rx_oblique, "rx_oblique", restart_CS)) then do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB OBC%rx_oblique(I,j,k) = vel2_rescale * OBC%rx_oblique(I,j,k) enddo ; enddo ; enddo endif - if (query_initialized(OBC%ry_oblique, "ry_oblique", restart_CSp)) then + if (query_initialized(OBC%ry_oblique, "ry_oblique", restart_CS)) then do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied OBC%ry_oblique(i,J,k) = vel2_rescale * OBC%ry_oblique(i,J,k) enddo ; enddo ; enddo endif - if (query_initialized(OBC%cff_normal, "cff_normal", restart_CSp)) then + if (query_initialized(OBC%cff_normal, "cff_normal", restart_CS)) then do k=1,nz ; do J=JsdB,JedB ; do I=IsdB,IedB OBC%cff_normal(I,J,k) = vel2_rescale * OBC%cff_normal(I,J,k) enddo ; enddo ; enddo @@ -4927,14 +4927,14 @@ subroutine flood_fill2(G, color, cin, cout, cland) end subroutine flood_fill2 !> Register OBC segment data for restarts -subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart_CSp, & +subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart_CS, & use_temperature) type(hor_index_type), intent(in) :: HI !< Horizontal indices type(verticalGrid_type), pointer :: GV !< Container for vertical grid information type(ocean_OBC_type), pointer :: OBC !< OBC data structure, data intent(inout) type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables type(vardesc) :: vd(2) @@ -4966,7 +4966,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart vd(1) = var_desc("rx_normal", "m s-1", "Normal Phase Speed for EW radiation OBCs", 'u', 'L') vd(2) = var_desc("ry_normal", "m s-1", "Normal Phase Speed for NS radiation OBCs", 'v', 'L') call register_restart_pair(OBC%rx_normal, OBC%ry_normal, vd(1), vd(2), & - .false., restart_CSp) + .false., restart_CS) endif if (OBC%oblique_BCs_exist_globally) then @@ -4976,11 +4976,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart vd(1) = var_desc("rx_oblique", "m2 s-2", "Radiation Speed Squared for EW oblique OBCs", 'u', 'L') vd(2) = var_desc("ry_oblique", "m2 s-2", "Radiation Speed Squared for NS oblique OBCs", 'v', 'L') call register_restart_pair(OBC%rx_oblique, OBC%ry_oblique, vd(1), vd(2), & - .false., restart_CSp) + .false., restart_CS) allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("cff_normal", "m2 s-2", "denominator for oblique OBCs", 'q', 'L') - call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CSp) + call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CS) endif if (Reg%ntr == 0) return @@ -5006,11 +5006,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (modulo(HI%turns, 2) /= 0) then write(mesg,'("tres_y_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for NS OBCs",'v','L') - call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CS) else write(mesg,'("tres_x_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for EW OBCs",'u','L') - call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_x(:,:,:,m), vd(1), .false., restart_CS) endif endif enddo @@ -5022,11 +5022,11 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (modulo(HI%turns, 2) /= 0) then write(mesg,'("tres_x_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for EW OBCs",'u','L') - call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CS) else write(mesg,'("tres_y_",I3.3)') m vd(1) = var_desc(mesg,"Conc", "Tracer concentration for NS OBCs",'v','L') - call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CSp) + call register_restart_field(OBC%tres_y(:,:,:,m), vd(1), .false., restart_CS) endif endif enddo @@ -5433,14 +5433,14 @@ end subroutine rotate_OBC_segment_config !> Initialize the segments and field-related data of a rotated OBC. -subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CSp, OBC) +subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC) type(ocean_OBC_type), pointer, intent(in) :: OBC_in !< OBC on input map type(ocean_grid_type), intent(in) :: G !< Rotated grid metric type(verticalGrid_type), intent(in) :: GV !< Vertical grid type(unit_scale_type), intent(in) :: US !< Unit scaling type(param_file_type), intent(in) :: param_file !< Input parameters type(thermo_var_ptrs), intent(inout) :: tv !< Tracer fields - type(MOM_restart_CS), pointer, intent(in) :: restart_CSp !< Restart CS + type(MOM_restart_CS), intent(in) :: restart_CS !< Restart CS type(ocean_OBC_type), pointer, intent(inout) :: OBC !< Rotated OBC logical :: use_temperature @@ -5457,7 +5457,7 @@ subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CSp, OBC) if (use_temperature) & call fill_temp_salt_segments(G, GV, OBC, tv) - call open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) + call open_boundary_init(G, GV, US, param_file, OBC, restart_CS) end subroutine rotate_OBC_init diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 5d81db10a3..019cfe135c 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -137,7 +137,7 @@ module MOM_restart subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS) character(*), intent(in) :: field_name !< Name of restart field that is no longer in use character(*), intent(in) :: replacement_name !< Name of replacement restart field, if applicable - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct CS%num_obsolete_vars = CS%num_obsolete_vars+1 CS%restart_obsolete(CS%num_obsolete_vars)%field_name = field_name @@ -151,10 +151,7 @@ subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -184,10 +181,7 @@ subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -217,10 +211,7 @@ subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -249,10 +240,7 @@ subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -281,10 +269,7 @@ subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS) type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) - - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "register_restart_field: Module must be initialized before it is used.") + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct call lock_check(CS, var_desc) @@ -316,7 +301,7 @@ subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, & type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing - type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -338,7 +323,7 @@ subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, & type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing - type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -360,7 +345,7 @@ subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, & type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing - type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure call lock_check(CS, a_desc) @@ -384,7 +369,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -393,10 +378,6 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_4d: Module must be initialized before "//& - "it is used to register "//trim(name)) - call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & @@ -414,7 +395,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -423,10 +404,6 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_3d: Module must be initialized before "//& - "it is used to register "//trim(name)) - call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & @@ -444,7 +421,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent @@ -454,9 +431,6 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd character(len=8) :: Zgrid - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_2d: Module must be initialized before "//& - "it is used to register "//trim(name)) zgrid = '1' ; if (present(z_grid)) zgrid = z_grid call lock_check(CS, name=name) @@ -475,7 +449,7 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, '1' if absent @@ -485,9 +459,6 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units type(vardesc) :: vd character(len=8) :: hgrid - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_3d: Module must be initialized before "//& - "it is used to register "//trim(name)) hgrid = '1' ; if (present(hor_grid)) hgrid = hor_grid call lock_check(CS, name=name) @@ -506,17 +477,13 @@ subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent type(vardesc) :: vd - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & - "register_restart_field_0d: Module must be initialized before "//& - "it is used to register "//trim(name)) - call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid='1', & @@ -530,14 +497,12 @@ end subroutine register_restart_field_0d !> query_initialized_name determines whether a named field has been successfully !! read from a restart file yet. function query_initialized_name(name, CS) result(query_initialized) - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -563,13 +528,11 @@ end function query_initialized_name !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_0d(f_ptr, CS) result(query_initialized) real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -588,13 +551,11 @@ end function query_initialized_0d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_1d(f_ptr, CS) result(query_initialized) real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -614,13 +575,11 @@ end function query_initialized_1d function query_initialized_2d(f_ptr, CS) result(query_initialized) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -640,13 +599,11 @@ end function query_initialized_2d function query_initialized_3d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -666,13 +623,11 @@ end function query_initialized_3d function query_initialized_4d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -692,14 +647,12 @@ end function query_initialized_4d !! name has been initialized from a restart file. function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -726,14 +679,12 @@ end function query_initialized_0d_name function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -760,14 +711,12 @@ end function query_initialized_1d_name function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -794,14 +743,12 @@ end function query_initialized_2d_name function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -828,14 +775,12 @@ end function query_initialized_3d_name function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field that is being queried - character(len=*), intent(in) :: name !< The name of the field that is being queried - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized integer :: m, n - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -863,8 +808,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ !! are to be written type(time_type), intent(in) :: time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct logical, optional, intent(in) :: time_stamped !< If present and true, add time-stamp !! to the restart file names character(len=*), optional, intent(in) :: filename !< A filename that overrides the name in CS%restartfile @@ -906,8 +850,6 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ turns = CS%turns - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "save_restart: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) ! With parallel read & write, it is possible to disable the following... @@ -1068,8 +1010,7 @@ subroutine restore_state(filename, directory, day, G, CS) character(len=*), intent(in) :: directory !< The directory in which to find restart files type(time_type), intent(out) :: day !< The time of the restarted run type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct ! Local variables character(len=200) :: filepath ! The path (dir/file) to the file being opened. @@ -1097,8 +1038,6 @@ subroutine restore_state(filename, directory, day, G, CS) integer(kind=8) :: checksum_file ! The checksum value recorded in the input file. integer(kind=8) :: checksum_data ! The checksum value for the data that was read in. - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "restore_state: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) ! Get NetCDF ids for all of the restart files. @@ -1285,23 +1224,18 @@ function restart_files_exist(filename, directory, G, CS) !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: restart_files_exist !< The function result, which indicates whether !! any of the explicitly or automatically named !! restart files exist in directory integer :: num_files - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "restart_files_exist: Module must be initialized before it is used.") - if ((LEN_TRIM(filename) == 1) .and. (filename(1:1) == 'F')) then num_files = get_num_restart_files('r', directory, G, CS) else num_files = get_num_restart_files(filename, directory, G, CS) endif restart_files_exist = (num_files > 0) - end function restart_files_exist !> determine_is_new_run determines from the value of filename and the existence @@ -1312,14 +1246,11 @@ function determine_is_new_run(filename, directory, G, CS) result(is_new_run) !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct logical :: is_new_run !< The function result, which indicates whether !! this is a new run, based on the value of !! filename and whether restart files exist - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "determine_is_new_run: Module must be initialized before it is used.") if (LEN_TRIM(filename) > 1) then CS%new_run = .false. elseif (LEN_TRIM(filename) == 0) then @@ -1339,13 +1270,11 @@ end function determine_is_new_run !> is_new_run returns whether this is going to be a new run based on the !! information stored in CS by a previous call to determine_is_new_run. function is_new_run(CS) - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + logical :: is_new_run !< The function result, which had been stored in CS during !! a previous call to determine_is_new_run - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "is_new_run: Module must be initialized before it is used.") if (.not.CS%new_run_set) call MOM_error(FATAL, "MOM_restart " // & "determine_is_new_run must be called for a restart file before is_new_run.") @@ -1360,8 +1289,8 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + type(file_type), dimension(:), & optional, intent(out) :: IO_handles !< The I/O handles of all opened files character(len=*), dimension(:), & @@ -1388,9 +1317,6 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, character(len=32) :: filename_appendix = '' ! Filename appendix for ensemble runs character(len=80) :: restartname - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "open_restart_units: Module must be initialized before it is used.") - ! Get NetCDF ids for all of the restart files. num_restart = 0 ; nf = 0 ; start_char = 1 do while (start_char <= len_trim(filename) ) @@ -1496,16 +1422,13 @@ function get_num_restart_files(filenames, directory, G, CS, file_paths) result(n !! character 'r' to read automatically named files character(len=*), intent(in) :: directory !< The directory in which to find restart files type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous - !! call to restart_init + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct character(len=*), dimension(:), & optional, intent(out) :: file_paths !< The full paths to the restart files. + integer :: num_files !< The function result, the number of files (both automatically named !! restart files and others explicitly in filename) that have been opened - if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & - "get_num_restart_files: Module must be initialized before it is used.") - ! This call uses open_restart_units without the optional arguments needed to actually ! open the files to determine the number of restart files. num_files = open_restart_units(filenames, directory, G, CS, file_paths=file_paths) @@ -1654,7 +1577,7 @@ subroutine restart_end(CS) end subroutine restart_end subroutine restart_error(CS) - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct character(len=16) :: num ! String for error messages diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 08c50fa09a..df2e801613 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -228,7 +228,7 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 9b9fdac145..6a4d4195d5 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -136,8 +136,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & !! for model parameter values. type(directories), intent(in) :: dirs !< A structure containing several relevant !! directory paths. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct type(ALE_CS), pointer :: ALE_CSp !< The ALE control structure for remapping type(tracer_registry_type), pointer :: tracer_Reg !< A pointer to the tracer registry type(sponge_CS), pointer :: sponge_CSp !< The layerwise sponge control structure. @@ -653,8 +652,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, & PF, oda_incupd_CSp, restart_CS, Time) endif - - end subroutine MOM_initialize_state !> Reads the layer thicknesses or interface heights from a file. @@ -2060,8 +2057,7 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(oda_incupd_CS), pointer :: oda_incupd_CSp !< A pointer that is set to point to the control !! structure for this module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in !! overrides any value set for !Time. diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 91210a328d..ab3621296f 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -92,14 +92,12 @@ module MOM_oda_incupd !> This subroutine defined the control structure of module and register !the time counter to full update in restart subroutine initialize_oda_incupd_fixed( G, GV, US, CS, restart_CS) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module (in/out). - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -116,28 +114,23 @@ subroutine initialize_oda_incupd_fixed( G, GV, US, CS, restart_CS) ! register ncount in restart call register_restart_field(CS%ncount, "oda_incupd_ncount", .false., restart_CS,& "Number of inc. update already done", "N/A") - - end subroutine initialize_oda_incupd_fixed !> This subroutine defined the number of time step for full update, stores the layer pressure !! increments and initialize remap structure. subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, restart_CS) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - integer, intent(in) :: nz_data !< The total number of incr. input layers. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. - type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module (in/out). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: nz_data !< The total number of incr. input layers. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + type(oda_incupd_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The ODA h !! [H ~> m or kg m-2]. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. - + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" @@ -242,8 +235,6 @@ subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, res ! Call the constructor for remapping control structure call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation, & answers_2018=.false.) - - end subroutine initialize_oda_incupd diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 551caa625e..e4f18e75d7 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1022,7 +1022,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! Local variables real :: I_T_rescale ! A rescaling factor for time from the internal representation in this @@ -1379,7 +1379,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_GMECoeff, MEKE_KHCoeff, MEKE_viscCoeff_Ku, MEKE_viscCoeff_Au diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fd420a261f..d0bdff8578 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -2080,7 +2080,7 @@ end subroutine PPM_limit_pos ! type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure ! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! type(int_tide_CS), intent(in) :: CS !< Internal tide control struct -! type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. +! type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! ! This subroutine is not currently in use!! diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 9cfbf8f5f8..bb37245c5b 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -795,7 +795,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct ! Local variables real :: H_rescale ! A rescaling factor for thicknesses from the representation in @@ -940,7 +940,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables type(vardesc) :: vd logical :: mixedlayer_restrat_init diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1cf3b5ddc9..902c22240b 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1807,7 +1807,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities and related fields. !! Allocated here. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL @@ -1898,7 +1898,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! related fields. Allocated here. type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 62181fe9ea..2d18b7c907 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -65,7 +65,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(DOME_tracer_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 144b21e29a..013b04a5b3 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -71,7 +71,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(ISOMIP_tracer_CS), pointer :: CS ! advection_xy ; endif - if (present(restart_CS)) then ; if (associated(restart_CS)) then + if (present(restart_CS)) then ! Register this tracer to be read from and written to restart files. mand = .true. ; if (present(mandatory)) mand = mandatory call register_restart_field(tr_ptr, Tr%name, mand, restart_CS, & longname=Tr%longname, units=Tr%units) - endif ; endif - + endif end subroutine register_tracer diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 274f85d435..244eebb2bc 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -72,7 +72,7 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(RGC_tracer_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct character(len=80) :: name, longname ! This include declares and sets the variable "version". diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4d05d43fd9..d6d1ac25fe 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -71,7 +71,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 3aaa51b301..bc5d19b4fb 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -69,7 +69,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=40) :: mdl = "boundary_impulse_tracer" ! This module's name. diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index a26c967eae..9a3ca019bd 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -72,7 +72,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) !! structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and diffusion module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables ! This include declares and sets the variable "version". diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index f299febfa8..b6bd212a37 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -56,7 +56,7 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(dyed_obc_tracer_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index ffe4f9df72..60d9c02aa0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -76,7 +76,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 index 4578a422dc..fcb9f3e854 100644 --- a/src/tracer/nw2_tracers.F90 +++ b/src/tracer/nw2_tracers.F90 @@ -51,7 +51,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This include declares and sets the variable "version". #include "version_variable.h" diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index fcc0de23d8..0ebf9dcfc9 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -78,7 +78,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=40) :: mdl = "oil_tracer" ! This module's name. diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index cd1ee41ebd..5ba61923ed 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -62,7 +62,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 3eb83a79c5..b58e45b366 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -60,7 +60,7 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and !! diffusion module - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 277c0423aa..4d44e580e0 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -411,7 +411,7 @@ subroutine register_ctrl_forcing_restarts(G, param_file, CS, restart_CS) !! parameter values. type(ctrl_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct logical :: controlled, use_temperature character (len=8) :: period_str From 09a990c3c097391e693ad2694f6fcb22627c128c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 26 Oct 2021 13:44:11 -0400 Subject: [PATCH 051/138] Barotropic CS pointer removal * Instances of `barotropic_CS` pointers changed to locals * `barotropic_CSp` removed from MOM module, as it was unused * `frhat[uv]1` converted to allocatable * `BT_OBC` field pointers to allocatable --- src/core/MOM.F90 | 2 - src/core/MOM_barotropic.F90 | 85 +++++++++++------------------ src/core/MOM_dynamics_split_RK2.F90 | 5 +- 3 files changed, 34 insertions(+), 58 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e1927da1f0..32630af467 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -359,8 +359,6 @@ module MOM !< Pointer to the control structure for the MEKE updates type(VarMix_CS) :: VarMix !< Control structure for the variable mixing module - type(Barotropic_CS), pointer :: Barotropic_CSp => NULL() - !< Pointer to the control structure for the barotropic module type(tracer_registry_type), pointer :: tracer_Reg => NULL() !< Pointer to the MOM tracer registry type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6a64b84234..f49ce0073b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -6,7 +6,7 @@ module MOM_barotropic use MOM_debugging, only : hchksum, uvchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field -use MOM_diag_mediator, only : safe_alloc_ptr, diag_ctrl, enable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averaging use MOM_domains, only : min_across_PEs, clone_MOM_domain, deallocate_MOM_domain use MOM_domains, only : To_All, Scalar_Pair, AGRID, CORNER, MOM_domain_type use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type @@ -67,22 +67,22 @@ module MOM_barotropic !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type - real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, - !! as set by the open boundary conditions [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, - !! as set by the open boundary conditions [L T-1 ~> m s-1]. - real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain - !! at a u-point with an open boundary condition [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain - !! at a v-point with an open boundary condition [H ~> m or kg m-2]. + real, allocatable :: Cg_u(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, allocatable :: Cg_v(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, allocatable :: H_u(:,:) !< The total thickness at the u-points [H ~> m or kg m-2]. + real, allocatable :: H_v(:,:) !< The total thickness at the v-points [H ~> m or kg m-2]. + real, allocatable :: uhbt(:,:) !< The zonal barotropic thickness fluxes specified + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, allocatable :: vhbt(:,:) !< The meridional barotropic thickness fluxes specified + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, allocatable :: ubt_outer(:,:) !< The zonal velocities just outside the domain, + !! as set by the open boundary conditions [L T-1 ~> m s-1]. + real, allocatable :: vbt_outer(:,:) !< The meridional velocities just outside the domain, + !! as set by the open boundary conditions [L T-1 ~> m s-1]. + real, allocatable :: eta_outer_u(:,:) !< The surface height outside of the domain + !! at a u-point with an open boundary condition [H ~> m or kg m-2]. + real, allocatable :: eta_outer_v(:,:) !< The surface height outside of the domain + !! at a v-point with an open boundary condition [H ~> m or kg m-2]. logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point. logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point. !>@{ Index ranges for the open boundary conditions @@ -149,8 +149,8 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & q_D !< f / D at PV points [Z-1 T-1 ~> m-1 s-1]. - real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. - real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. + real, allocatable :: frhatu1(:,:,:) !< Predictor step values of frhatu stored for diagnostics. + real, allocatable :: frhatv1(:,:,:) !< Predictor step values of frhatv stored for diagnostics. type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields !! for applying open boundary conditions. @@ -451,8 +451,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - type(barotropic_CS), pointer :: CS !< The control structure returned by a - !! previous call to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: visc_rem_u !< Both the fraction of the momentum !! originally in a layer that remains after a time-step of !! viscosity, and the fraction of a time-step's worth of a @@ -695,8 +694,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, integer :: ioff, joff integer :: l_seg - if (.not.associated(CS)) call MOM_error(FATAL, & - "btstep: Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -2718,7 +2715,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(barotropic_CS), pointer :: CS !< Barotropic control structure. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: pbce !< The baroclinic pressure @@ -2767,8 +2764,6 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) character(len=200) :: mesg integer :: i, j, k, is, ie, js, je, nz - if (.not.associated(CS)) call MOM_error(FATAL, & - "set_dtbt: Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed @@ -3044,7 +3039,7 @@ end subroutine apply_velocity_OBCs !! boundary conditions, as developed by Mehmet Ilicak. subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, & integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v) - type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type. + type(ocean_OBC_type), intent(inout) :: OBC !< An associated pointer to an OBC type. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or @@ -3263,8 +3258,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -3304,8 +3298,6 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! This section interpolates thicknesses onto u & v grid points with the ! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-). - if (.not.associated(CS)) call MOM_error(FATAL, & - "btcalc: Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return use_default = .false. @@ -4090,8 +4082,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. + type(barotropic_CS), intent(in) :: CS !< Barotropic control struct integer, intent(in) :: halo !< The halo size to use, default = 1. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & optional, intent(in) :: eta !< The barotropic free surface height anomaly @@ -4185,8 +4176,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) !! fluxes (and update the slowly varying part of eta_cor) !! (.true.) or whether to incrementally update the !! corrective fluxes. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous call - !! to barotropic_init. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct ! Local variables real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses [H ~> m or kg m-2]. @@ -4196,8 +4186,6 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) ! thicknesses [H ~> m or kg m-2]. integer :: is, ie, js, je, nz, i, j, k - if (.not.associated(CS)) call MOM_error(FATAL, "bt_mass_source: "// & - "Module MOM_barotropic must be initialized before it is used.") if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -4251,8 +4239,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module - !! that is set in register_barotropic_restarts. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must !! be recalculated before stepping. @@ -4880,8 +4867,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, & 'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) - if (CS%id_frhatu1 > 0) call safe_alloc_ptr(CS%frhatu1, IsdB,IedB,jsd,jed,nz) - if (CS%id_frhatv1 > 0) call safe_alloc_ptr(CS%frhatv1, isd,ied,JsdB,JedB,nz) + if (CS%id_frhatu1 > 0) allocate(CS%frhatu1(IsdB:IedB,jsd:jed,nz), source=0.) + if (CS%id_frhatv1 > 0) allocate(CS%frhatv1(isd:ied,JsdB:JedB,nz), source=0.) if (.NOT.query_initialized(CS%ubtav,"ubtav",restart_CS) .or. & .NOT.query_initialized(CS%vbtav,"vbtav",restart_CS)) then @@ -4961,7 +4948,7 @@ end subroutine barotropic_init !> Copies ubtav and vbtav from private type into arrays subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) - type(barotropic_CS), pointer :: CS !< Control structure for this module + type(barotropic_CS), intent(in) :: CS !< Barotropic control struct type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged !! over a baroclinic timestep [L T-1 ~> m s-1] @@ -4997,8 +4984,8 @@ subroutine barotropic_end(CS) DEALLOC_(CS%eta_cor) DEALLOC_(CS%frhatu) ; DEALLOC_(CS%frhatv) - if (associated(CS%frhatu1)) deallocate(CS%frhatu1) - if (associated(CS%frhatv1)) deallocate(CS%frhatv1) + if (allocated(CS%frhatu1)) deallocate(CS%frhatu1) + if (allocated(CS%frhatv1)) deallocate(CS%frhatv1) call deallocate_MOM_domain(CS%BT_domain) ! Allocated in restart registration, prior to timestep initialization @@ -5010,8 +4997,7 @@ end subroutine barotropic_end subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(barotropic_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module. + type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct @@ -5023,13 +5009,6 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB - if (associated(CS)) then - call MOM_error(WARNING, "register_barotropic_restarts called with an associated "// & - "control structure.") - return - endif - allocate(CS) - call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & "If true, adjust the initial conditions for the "//& "barotropic solver to the values from the layered "//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 9961f712d9..1a8e68bc8d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -206,12 +206,12 @@ module MOM_dynamics_split_RK2 type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() - !> A pointer to the barotropic stepping control structure - type(barotropic_CS), pointer :: barotropic_CSp => NULL() !> A pointer to a structure containing interface height diffusivities type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure type(set_visc_CS), pointer :: set_visc_CSp => NULL() + !> A pointer to the barotropic stepping control structure + type(barotropic_CS) :: barotropic_CSp !> A pointer to the tidal forcing control structure type(tidal_forcing_CS) :: tides_CSp !> A pointer to the ALE control structure. @@ -1689,7 +1689,6 @@ subroutine end_dyn_split_RK2(CS) type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure call barotropic_end(CS%barotropic_CSp) - deallocate(CS%barotropic_CSp) call vertvisc_end(CS%vertvisc_CSp) deallocate(CS%vertvisc_CSp) From 8632fee081541b385288f0c9c4c1e18148ee476f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 27 Oct 2021 05:31:05 -0400 Subject: [PATCH 052/138] Wave structure CS pointer * `wave_structure_CS` instances changed from pointer to local * T and S aliases to `tv` in `MOM_wave_structure` removed * `wave_structure_CSp` renamed to `wave_struct` in internal tides --- src/diagnostics/MOM_wave_structure.F90 | 28 +++++-------------- .../lateral/MOM_internal_tides.F90 | 15 +++++----- 2 files changed, 14 insertions(+), 29 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index cf4c518889..3ae4f218d4 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -102,8 +102,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !! gravity wave speed [L T-1 ~> m s-1]. integer, intent(in) :: ModeNum !< Mode number real, intent(in) :: freq !< Intrinsic wave frequency [T-1 ~> s-1]. - type(wave_structure_CS), pointer :: CS !< The control structure returned by a - !! previous call to wave_structure_init. + type(wave_structure_CS), intent(inout) :: CS !< Wave structure control struct real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: En !< Internal wave energy density [R Z3 T-2 ~> J m-2] logical, optional, intent(in) :: full_halos !< If true, do the calculation @@ -145,7 +144,6 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: I_Hnew !< The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum !< The sum of density diffrences across interfaces times thicknesses [R Z ~> kg m-2] real, parameter :: tol1 = 0.0001, tol2 = 0.001 - real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 !< G_Earth/Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. ! real :: rescale, I_rescale integer :: kf(SZI_(G)) @@ -193,18 +191,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke I_a_int = 1/a_int - !if (present(CS)) then - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_structure: "// & - "Module must be initialized before it is used.") - !endif - if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif Pi = (4.0*atan(1.0)) - S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 !if (CS%debug) call chksum0(g_Rho0, "g/rho0 in wave struct", & @@ -242,12 +234,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Start a new layer H_here(i) = h(i,j,k)*GV%H_to_Z - HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) else H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z - HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) + HxT_here(i) = HxT_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -727,8 +719,8 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. - type(wave_structure_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module. + type(wave_structure_CS), intent(inout) :: CS !< Wave structure control struct + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_wave_structure" ! This module's name. @@ -736,12 +728,6 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - if (associated(CS)) then - call MOM_error(WARNING, "wave_structure_init called with an "// & - "associated control structure.") - return - else ; allocate(CS) ; endif - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index d0bdff8578..eb7d3a6340 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -116,8 +116,7 @@ module MOM_internal_tides type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - type(wave_structure_CS), pointer :: wave_structure_CSp => NULL() - !< A pointer to the wave_structure module control structure + type(wave_structure_CS) :: wave_struct !< Wave structure control struct !>@{ Diag handles ! Diag handles relevant to all modes, frequencies, and angles @@ -404,13 +403,13 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do m=1,CS%NMode ; do fr=1,CS%Nfreq ! Calculate modal structure for given mode and frequency call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, CS%frequency(fr), & - CS%wave_structure_CSp, tot_En_mode(:,:,fr,m), full_halos=.true.) + CS%wave_struct, tot_En_mode(:,:,fr,m), full_halos=.true.) ! Pick out near-bottom and max horizontal baroclinic velocity values at each point do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging - nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) + nzm = CS%wave_struct%num_intfaces(i,j) + Ub(i,j,fr,m) = CS%wave_struct%Uavg_profile(i,j,nzm) + Umax(i,j,fr,m) = maxval(CS%wave_struct%Uavg_profile(i,j,1:nzm)) enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -448,7 +447,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) - nzm = CS%wave_structure_CSp%num_intfaces(i,j) + nzm = CS%wave_struct%num_intfaces(i,j) Fr2_max = (Umax(i,j,fr,m) / c_phase)**2 ! Dissipate energy if Fr>1; done here with an arbitrary time scale if (Fr2_max > 1.0) then @@ -2558,7 +2557,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo ! Initialize wave_structure (not sure if this should be here - BDM) - call wave_structure_init(Time, G, GV, param_file, diag, CS%wave_structure_CSp) + call wave_structure_init(Time, G, GV, param_file, diag, CS%wave_struct) end subroutine internal_tides_init From b1765713fd979c378298a1a4a0995a72438a6080 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 27 Oct 2021 11:32:04 -0400 Subject: [PATCH 053/138] ALE sponge pointer removal (partial) * Some instances of `ALE_sponge_CS` declared as local * Redfined many allocatable arrays declared as pointers Much of this module was left unmodified, due to a lot of decision making based on the associated status of the CS. --- .../vertical/MOM_ALE_sponge.F90 | 55 ++++++++----------- 1 file changed, 22 insertions(+), 33 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 4d179e2bfb..472ee21e36 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -69,7 +69,6 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field. integer :: num_tlevs !< The number of time records contained in the file - real, dimension(:,:,:), pointer :: mask_in => NULL() !< pointer to the data mask. real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data. real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid. end type p3d @@ -79,7 +78,6 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field integer :: num_tlevs !< The number of time records contained in the file - real, dimension(:,:), pointer :: mask_in => NULL()!< pointer to the data mask. real, dimension(:,:), pointer :: p => NULL() !< pointer the data. real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. end type p2d @@ -94,16 +92,16 @@ module MOM_ALE_sponge integer :: fldno = 0 !< The number of fields which have already been !! registered by calls to set_up_sponge_field logical :: sponge_uv !< Control whether u and v are included in sponge - integer, pointer :: col_i(:) => NULL() !< Array of the i-indices of each tracer column being damped. - integer, pointer :: col_j(:) => NULL() !< Array of the j-indices of each tracer column being damped. - integer, pointer :: col_i_u(:) => NULL() !< Array of the i-indices of each u-column being damped. - integer, pointer :: col_j_u(:) => NULL() !< Array of the j-indices of each u-column being damped. - integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indices of each v-column being damped. - integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indices of each v-column being damped. + integer, allocatable :: col_i(:) !< Array of the i-indices of each tracer column being damped + integer, allocatable :: col_j(:) !< Array of the j-indices of each tracer column being damped + integer, allocatable :: col_i_u(:) !< Array of the i-indices of each u-column being damped + integer, allocatable :: col_j_u(:) !< Array of the j-indices of each u-column being damped + integer, allocatable :: col_i_v(:) !< Array of the i-indices of each v-column being damped + integer, allocatable :: col_j_v(:) !< Array of the j-indices of each v-column being damped - real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column [T-1 ~> s-1]. - real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column [T-1 ~> s-1]. - real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column [T-1 ~> s-1]. + real, allocatable :: Iresttime_col(:) !< The inverse restoring time of each tracer column [T-1 ~> s-1] + real, allocatable :: Iresttime_col_u(:) !< The inverse restoring time of each u-column [T-1 ~> s-1] + real, allocatable :: Iresttime_col_v(:) !< The inverse restoring time of each v-column [T-1 ~> s-1] type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -366,15 +364,10 @@ end subroutine initialize_ALE_sponge_fixed !> Return the number of layers in the data with a fixed ALE sponge, or 0 if there are !! no sponge columns on this PE. function get_ALE_sponge_nz_data(CS) - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for the ALE_sponge module. + type(ALE_sponge_CS), intent(in) :: CS !< ALE sponge control struct integer :: get_ALE_sponge_nz_data !< The number of layers in the fixed sponge data. - if (associated(CS)) then - get_ALE_sponge_nz_data = CS%nz_data - else - get_ALE_sponge_nz_data = 0 - endif + get_ALE_sponge_nz_data = CS%nz_data end function get_ALE_sponge_nz_data !> Return the thicknesses used for the data with a fixed ALE sponge @@ -600,11 +593,9 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS, US) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure + type(ALE_sponge_CS), intent(inout) :: CS !< ALE sponge control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - if (.not.associated(CS)) return - CS%diag => diag CS%id_sp_tendency(1) = -1 @@ -1277,8 +1268,7 @@ end subroutine rotate_ALE_sponge ! after rotation. This function is part of a temporary solution until ! something more robust is developed. subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) - type(ALE_sponge_CS), pointer :: sponge !< A pointer to the control structure for this module - !! that is set by a previous call to initialize_ALE_sponge. + type(ALE_sponge_CS), intent(inout) :: sponge !< ALE sponge control struct real, dimension(:,:,:), & target, intent(in) :: p_old !< The previous array of target values type(ocean_grid_type), intent(in) :: G !< The updated ocean grid structure @@ -1291,7 +1281,6 @@ subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) do n=1,sponge%fldno if (associated(sponge%var(n)%p, p_old)) sponge%var(n)%p => p_new enddo - end subroutine update_ALE_sponge_field @@ -1306,16 +1295,16 @@ subroutine ALE_sponge_end(CS) if (.not.associated(CS)) return - if (associated(CS%col_i)) deallocate(CS%col_i) - if (associated(CS%col_i_u)) deallocate(CS%col_i_u) - if (associated(CS%col_i_v)) deallocate(CS%col_i_v) - if (associated(CS%col_j)) deallocate(CS%col_j) - if (associated(CS%col_j_u)) deallocate(CS%col_j_u) - if (associated(CS%col_j_v)) deallocate(CS%col_j_v) + if (allocated(CS%col_i)) deallocate(CS%col_i) + if (allocated(CS%col_i_u)) deallocate(CS%col_i_u) + if (allocated(CS%col_i_v)) deallocate(CS%col_i_v) + if (allocated(CS%col_j)) deallocate(CS%col_j) + if (allocated(CS%col_j_u)) deallocate(CS%col_j_u) + if (allocated(CS%col_j_v)) deallocate(CS%col_j_v) - if (associated(CS%Iresttime_col)) deallocate(CS%Iresttime_col) - if (associated(CS%Iresttime_col_u)) deallocate(CS%Iresttime_col_u) - if (associated(CS%Iresttime_col_v)) deallocate(CS%Iresttime_col_v) + if (allocated(CS%Iresttime_col)) deallocate(CS%Iresttime_col) + if (allocated(CS%Iresttime_col_u)) deallocate(CS%Iresttime_col_u) + if (allocated(CS%Iresttime_col_v)) deallocate(CS%Iresttime_col_v) do m=1,CS%fldno if (associated(CS%Ref_val(m)%p)) deallocate(CS%Ref_val(m)%p) From 5b1dd3f96073913ae71bdfd3ac0126d356e1a5dc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 27 Oct 2021 15:38:28 -0400 Subject: [PATCH 054/138] MOM diagnostic pointer removal * diagnostic field pointers changed to allocatables * `safe_alloc_ptr` calls replaced with `allocate()` * Some instances of `diagnostics_CS` passed as type * `diagnostics_CS` in MOM_mod moved to stack --- src/core/MOM.F90 | 3 +- src/diagnostics/MOM_diagnostics.F90 | 307 +++++++++++++--------------- 2 files changed, 147 insertions(+), 163 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 32630af467..027127189d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -385,7 +385,7 @@ module MOM ! Pointers to control structures used for diagnostics type(sum_output_CS), pointer :: sum_output_CSp => NULL() !< Pointer to the globally summed output control structure - type(diagnostics_CS), pointer :: diagnostics_CSp => NULL() + type(diagnostics_CS) :: diagnostics_CSp !< Pointer to the MOM diagnostics control structure type(offline_transport_CS), pointer :: offline_CSp => NULL() !< Pointer to the offline tracer transport control structure @@ -3592,7 +3592,6 @@ subroutine MOM_end(CS) endif call MOM_diagnostics_end(CS%diagnostics_CSp, CS%ADp, CS%CDp) - deallocate(CS%diagnostics_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index becf9c842b..bcee812c73 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -61,55 +61,51 @@ module MOM_diagnostics ! following arrays store diagnostics calculated here and unavailable outside. ! following fields have nz+1 levels. - real, pointer, dimension(:,:,:) :: & - e => NULL(), & !< interface height [Z ~> m] - e_D => NULL() !< interface height above bottom [Z ~> m] + real, allocatable :: e(:,:,:) !< interface height [Z ~> m] + real, allocatable :: e_D(:,:,:) !< interface height above bottom [Z ~> m] ! following fields have nz layers. - real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration [L T-2 ~> m s-2] - dv_dt => NULL(), & !< net j-acceleration [L T-2 ~> m s-2] - dh_dt => NULL(), & !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] - p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] - ! hf_du_dt => NULL(), hf_dv_dt => NULL() !< du_dt, dv_dt x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - - real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density - !! coordinates [H ~> m or kg m-2] - real, pointer, dimension(:,:,:) :: uh_Rlay => NULL() !< Zonal transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: vh_Rlay => NULL() !< Meridional transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: uhGM_Rlay => NULL() !< Zonal Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, pointer, dimension(:,:,:) :: vhGM_Rlay => NULL() !< Meridional Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: du_dt(:,:,:) !< net i-acceleration [L T-2 ~> m s-2] + real, allocatable :: dv_dt(:,:,:) !< net j-acceleration [L T-2 ~> m s-2] + real, allocatable :: dh_dt(:,:,:) !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] + real, allocatable :: p_ebt(:,:,:) !< Equivalent barotropic modal structure [nondim] + ! real, allocatable :: hf_du_dt(:,:,:), hf_dv_dt(:,:,:) !< du_dt, dv_dt x fract. thickness [L T-2 ~> m s-2]. + ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + + real, allocatable :: h_Rlay(:,:,:) !< Layer thicknesses in potential density + !! coordinates [H ~> m or kg m-2] + real, allocatable :: uh_Rlay(:,:,:) !< Zonal transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: vh_Rlay(:,:,:) !< Meridional transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: uhGM_Rlay(:,:,:) !< Zonal Gent-McWilliams transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] + real, allocatable :: vhGM_Rlay(:,:,:) !< Meridional Gent-McWilliams transports in potential density + !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] ! following fields are 2-D. - real, pointer, dimension(:,:) :: & - cg1 => NULL(), & !< First baroclinic gravity wave speed [L T-1 ~> m s-1] - Rd1 => NULL(), & !< First baroclinic deformation radius [L ~> m] - cfl_cg1 => NULL(), & !< CFL for first baroclinic gravity wave speed [nondim] - cfl_cg1_x => NULL(), & !< i-component of CFL for first baroclinic gravity wave speed [nondim] - cfl_cg1_y => NULL() !< j-component of CFL for first baroclinic gravity wave speed [nondim] + real, allocatable :: cg1(:,:) !< First baroclinic gravity wave speed [L T-1 ~> m s-1] + real, allocatable :: Rd1(:,:) !< First baroclinic deformation radius [L ~> m] + real, allocatable :: cfl_cg1(:,:) !< CFL for first baroclinic gravity wave speed [nondim] + real, allocatable :: cfl_cg1_x(:,:) !< i-component of CFL for first baroclinic gravity wave speed [nondim] + real, allocatable :: cfl_cg1_y(:,:) !< j-component of CFL for first baroclinic gravity wave speed [nondim] ! The following arrays hold diagnostics in the layer-integrated energy budget. - real, pointer, dimension(:,:,:) :: & - KE => NULL(), & !< KE per unit mass [L2 T-2 ~> m2 s-2] - dKE_dt => NULL(), & !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] - PE_to_KE => NULL(), & !< potential energy to KE term [m3 s-3] - KE_BT => NULL(), & !< barotropic contribution to KE term [m3 s-3] - KE_CorAdv => NULL(), & !< KE source from the combined Coriolis and - !! advection terms [H L2 T-3 ~> m3 s-3]. - !! The Coriolis source should be zero, but is not due to truncation - !! errors. There should be near-cancellation of the global integral - !! of this spurious Coriolis source. - KE_adv => NULL(), & !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] - KE_visc => NULL(), & !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] - KE_stress => NULL(), & !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] - KE_horvisc => NULL(), & !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] - KE_dia => NULL() !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE(:,:,:) !< KE per unit mass [L2 T-2 ~> m2 s-2] + real, allocatable :: dKE_dt(:,:,:) !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] + real, allocatable :: PE_to_KE(:,:,:) !< potential energy to KE term [m3 s-3] + real, allocatable :: KE_BT(:,:,:) !< barotropic contribution to KE term [m3 s-3] + real, allocatable :: KE_CorAdv(:,:,:) !< KE source from the combined Coriolis and + !! advection terms [H L2 T-3 ~> m3 s-3]. + !! The Coriolis source should be zero, but is not due to truncation + !! errors. There should be near-cancellation of the global integral + !! of this spurious Coriolis source. + real, allocatable :: KE_adv(:,:,:) !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_visc(:,:,:) !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_stress(:,:,:) !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_horvisc(:,:,:) !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_dia(:,:,:) !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] !>@{ Diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 @@ -384,13 +380,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_uv, uv, CS%diag) endif - if (associated(CS%e)) then + if (allocated(CS%e)) then call find_eta(h, tv, G, GV, US, CS%e, dZref=G%Z_ref) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif - if (associated(CS%e_D)) then - if (associated(CS%e)) then + if (allocated(CS%e_D)) then + if (allocated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e(i,j,k) + (G%bathyT(i,j) + G%Z_ref) enddo ; enddo ; enddo @@ -554,9 +550,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) - if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. associated(CS%h_Rlay) .or. & - associated(CS%uh_Rlay) .or. associated(CS%vh_Rlay) .or. & - associated(CS%uhGM_Rlay) .or. associated(CS%vhGM_Rlay)) then + if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. allocated(CS%h_Rlay) .or. & + allocated(CS%uh_Rlay) .or. allocated(CS%vh_Rlay) .or. & + allocated(CS%uhGM_Rlay) .or. allocated(CS%vhGM_Rlay)) then if (associated(tv%eqn_of_state)) then EOSdom(:) = EOS_domain(G%HI, halo=1) @@ -574,7 +570,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_Rml > 0) call post_data(CS%id_Rml, Rcv, CS%diag) if (CS%id_Rcv > 0) call post_data(CS%id_Rcv, Rcv, CS%diag) - if (associated(CS%h_Rlay)) then + if (allocated(CS%h_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(is,ie,js,je,nz,nkmb,CS,Rcv,h,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -595,7 +591,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h_Rlay > 0) call post_data(CS%id_h_Rlay, CS%h_Rlay, CS%diag) endif - if (associated(CS%uh_Rlay)) then + if (allocated(CS%uh_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CS,GV,uh) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -617,7 +613,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_uh_Rlay > 0) call post_data(CS%id_uh_Rlay, CS%uh_Rlay, CS%diag) endif - if (associated(CS%vh_Rlay)) then + if (allocated(CS%vh_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,nz,nkmb,Rcv,CS,GV,vh) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -638,7 +634,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_vh_Rlay > 0) call post_data(CS%id_vh_Rlay, CS%vh_Rlay, CS%diag) endif - if (associated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then + if (allocated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then k_list = nz/2 !$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CDP,CS,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -659,7 +655,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) endif - if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then + if (allocated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then k_list = nz/2 !$OMP parallel do default(none) shared(is,ie,Jsq,Jeq,nz,nkmb,CS,CDp,Rcv,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -1029,7 +1025,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_u(I,j) = 0.0 ; KE_v(i,J) = 0.0 enddo ; enddo - if (associated(CS%KE)) then + if (allocated(CS%KE)) then do k=1,nz ; do j=js,je ; do i=is,ie CS%KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 @@ -1041,14 +1037,14 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (.not.G%symmetric) then - if (associated(CS%dKE_dt) .OR. associated(CS%PE_to_KE) .OR. associated(CS%KE_BT) .OR. & - associated(CS%KE_CorAdv) .OR. associated(CS%KE_adv) .OR. associated(CS%KE_visc) .OR. & - associated(CS%KE_horvisc) .OR. associated(CS%KE_dia) ) then + if (allocated(CS%dKE_dt) .OR. allocated(CS%PE_to_KE) .OR. allocated(CS%KE_BT) .OR. & + allocated(CS%KE_CorAdv) .OR. allocated(CS%KE_adv) .OR. allocated(CS%KE_visc) .OR. & + allocated(CS%KE_horvisc) .OR. allocated(CS%KE_dia) ) then call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) endif endif - if (associated(CS%dKE_dt)) then + if (allocated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * CS%du_dt(I,j,k) @@ -1069,7 +1065,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_dKEdt > 0) call post_data(CS%id_dKEdt, CS%dKE_dt, CS%diag) endif - if (associated(CS%PE_to_KE)) then + if (allocated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%PFu(I,j,k) @@ -1087,7 +1083,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, CS%PE_to_KE, CS%diag) endif - if (associated(CS%KE_BT)) then + if (allocated(CS%KE_BT)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%u_accel_bt(I,j,k) @@ -1105,7 +1101,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_BT > 0) call post_data(CS%id_KE_BT, CS%KE_BT, CS%diag) endif - if (associated(CS%KE_CorAdv)) then + if (allocated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%CAu(I,j,k) @@ -1127,7 +1123,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_Coradv > 0) call post_data(CS%id_KE_Coradv, CS%KE_Coradv, CS%diag) endif - if (associated(CS%KE_adv)) then + if (allocated(CS%KE_adv)) then ! NOTE: All terms in KE_adv are multipled by -1, which can easily produce ! negative zeros and may signal a reproducibility issue over land. ! We resolve this by re-initializing and only evaluating over water points. @@ -1155,7 +1151,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_adv > 0) call post_data(CS%id_KE_adv, CS%KE_adv, CS%diag) endif - if (associated(CS%KE_visc)) then + if (allocated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc(I,j,k) @@ -1173,7 +1169,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_visc > 0) call post_data(CS%id_KE_visc, CS%KE_visc, CS%diag) endif - if (associated(CS%KE_stress)) then + if (allocated(CS%KE_stress)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_str(I,j,k) @@ -1191,7 +1187,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_stress > 0) call post_data(CS%id_KE_stress, CS%KE_stress, CS%diag) endif - if (associated(CS%KE_horvisc)) then + if (allocated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%diffu(I,j,k) @@ -1209,7 +1205,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_horvisc > 0) call post_data(CS%id_KE_horvisc, CS%KE_horvisc, CS%diag) endif - if (associated(CS%KE_dia)) then + if (allocated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_dia(I,j,k) @@ -1239,7 +1235,7 @@ subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) !< Time derivative operand real, dimension(lb(1):,lb(2):,:), target :: deriv_ptr !< Time derivative of f_ptr - type(diagnostics_CS), pointer :: CS !< Control structure returned by previous call to + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. ! This subroutine registers fields to calculate a diagnostic time derivative. @@ -1249,9 +1245,6 @@ subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) integer :: m !< New index of deriv_ptr in CS%deriv integer :: ub(3) !< Upper index bound of f_ptr, based on shape. - if (.not.associated(CS)) call MOM_error(FATAL, & - "register_time_deriv: Module must be initialized before it is used.") - if (CS%num_time_deriv >= MAX_FIELDS_) then call MOM_error(WARNING,"MOM_diagnostics: Attempted to register more than " // & "MAX_FIELDS_ diagnostic time derivatives via register_time_deriv.") @@ -1586,8 +1579,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. - type(diagnostics_CS), pointer :: CS !< Pointer set to point to control structure - !! for this module. + type(diagnostics_CS), intent(inout) :: CS !< Diagnostic control struct type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -1612,13 +1604,6 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "MOM_diagnostics_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - CS%diag => diag use_temperature = associated(tv%T) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & @@ -1737,11 +1722,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & 'Interface Height Relative to Mean Sea Level', 'm', conversion=US%Z_to_m) - if (CS%id_e>0) call safe_alloc_ptr(CS%e,isd,ied,jsd,jed,nz+1) + if (CS%id_e > 0) allocate(CS%e(isd:ied,jsd:jed,nz+1), source=0.) CS%id_e_D = register_diag_field('ocean_model', 'e_D', diag%axesTi, Time, & 'Interface Height above the Seafloor', 'm', conversion=US%Z_to_m) - if (CS%id_e_D>0) call safe_alloc_ptr(CS%e_D,isd,ied,jsd,jed,nz+1) + if (CS%id_e_D > 0) allocate(CS%e_D(isd:ied,jsd:jed,nz+1), source=0.) CS%id_Rml = register_diag_field('ocean_model', 'Rml', diag%axesTL, Time, & 'Mixed Layer Coordinate Potential Density', 'kg m-3', conversion=US%R_to_kg_m3) @@ -1762,22 +1747,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_du_dt>0) .and. .not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if ((CS%id_du_dt>0) .and. .not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_dv_dt>0) .and. .not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if ((CS%id_dv_dt>0) .and. .not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) - if ((CS%id_dh_dt>0) .and. .not.associated(CS%dh_dt)) then - call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) + if ((CS%id_dh_dt>0) .and. .not. allocated(CS%dh_dt)) then + allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif @@ -1786,8 +1771,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag ! v_extensive=.true.) !if (CS%id_hf_du_dt > 0) then ! call safe_alloc_ptr(CS%hf_du_dt,IsdB,IedB,jsd,jed,nz) - ! if (.not.associated(CS%du_dt)) then - ! call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + ! if (.not. allocated(CS%du_dt)) then + ! allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) ! call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) ! endif ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) @@ -1798,8 +1783,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag ! v_extensive=.true.) !if (CS%id_hf_dv_dt > 0) then ! call safe_alloc_ptr(CS%hf_dv_dt,isd,ied,JsdB,JedB,nz) - ! if (.not.associated(CS%dv_dt)) then - ! call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + ! if (.not. allocated(CS%dv_dt)) then + ! allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) ! call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) ! endif ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) @@ -1808,8 +1793,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_hf_du_dt_2d = register_diag_field('ocean_model', 'hf_dudt_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_du_dt_2d > 0) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if (.not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) @@ -1818,8 +1803,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_hf_dv_dt_2d = register_diag_field('ocean_model', 'hf_dvdt_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_dv_dt_2d > 0) then - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if (.not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) @@ -1828,8 +1813,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_h_du_dt = register_diag_field('ocean_model', 'h_du_dt', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_du_dt > 0) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if (.not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) @@ -1838,8 +1823,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_h_dv_dt = register_diag_field('ocean_model', 'h_dv_dt', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_dv_dt > 0) then - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if (.not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) @@ -1850,27 +1835,27 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_h_Rlay = register_diag_field('ocean_model', 'h_rho', diag%axesTL, Time, & 'Layer thicknesses in pure potential density coordinates', & thickness_units, conversion=convert_H) - if (CS%id_h_Rlay>0) call safe_alloc_ptr(CS%h_Rlay,isd,ied,jsd,jed,nz) + if (CS%id_h_Rlay > 0) allocate(CS%h_Rlay(isd:ied,jsd:jed,nz), source=0.) CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uh_Rlay>0) call safe_alloc_ptr(CS%uh_Rlay,IsdB,IedB,jsd,jed,nz) + if (CS%id_uh_Rlay > 0) allocate(CS%uh_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vh_Rlay>0) call safe_alloc_ptr(CS%vh_Rlay,isd,ied,JsdB,JedB,nz) + if (CS%id_vh_Rlay > 0) allocate(CS%vh_Rlay(isd:ied,JsdB:JedB,nz), source=0.) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & 'Zonal volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uhGM_Rlay>0) call safe_alloc_ptr(CS%uhGM_Rlay,IsdB,IedB,jsd,jed,nz) + if (CS%id_uhGM_Rlay>0) allocate(CS%uhGM_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & 'Meridional volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vhGM_Rlay>0) call safe_alloc_ptr(CS%vhGM_Rlay,isd,ied,JsdB,JedB,nz) + if (CS%id_vhGM_Rlay>0) allocate(CS%vhGM_Rlay(isd:ied,JsdB:JedB,nz), source=0.) !endif @@ -1878,55 +1863,55 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE = register_diag_field('ocean_model', 'KE', diag%axesTL, Time, & 'Layer kinetic energy per unit mass', & 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (CS%id_KE>0) call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) + if (CS%id_KE > 0) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) CS%id_dKEdt = register_diag_field('ocean_model', 'dKE_dt', diag%axesTL, Time, & 'Kinetic Energy Tendency of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_dKEdt>0) call safe_alloc_ptr(CS%dKE_dt,isd,ied,jsd,jed,nz) + if (CS%id_dKEdt > 0) allocate(CS%dKE_dt(isd:ied,jsd:jed,nz), source=0.) CS%id_PE_to_KE = register_diag_field('ocean_model', 'PE_to_KE', diag%axesTL, Time, & 'Potential to Kinetic Energy Conversion of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_PE_to_KE>0) call safe_alloc_ptr(CS%PE_to_KE,isd,ied,jsd,jed,nz) + if (CS%id_PE_to_KE > 0) allocate(CS%PE_to_KE(isd:ied,jsd:jed,nz), source=0.) if (split) then CS%id_KE_BT = register_diag_field('ocean_model', 'KE_BT', diag%axesTL, Time, & 'Barotropic contribution to Kinetic Energy', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_BT>0) call safe_alloc_ptr(CS%KE_BT,isd,ied,jsd,jed,nz) + if (CS%id_KE_BT > 0) allocate(CS%KE_BT(isd:ied,jsd:jed,nz), source=0.) endif CS%id_KE_Coradv = register_diag_field('ocean_model', 'KE_Coradv', diag%axesTL, Time, & 'Kinetic Energy Source from Coriolis and Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_Coradv>0) call safe_alloc_ptr(CS%KE_Coradv,isd,ied,jsd,jed,nz) + if (CS%id_KE_Coradv > 0) allocate(CS%KE_Coradv(isd:ied,jsd:jed,nz), source=0.) CS%id_KE_adv = register_diag_field('ocean_model', 'KE_adv', diag%axesTL, Time, & 'Kinetic Energy Source from Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_adv>0) call safe_alloc_ptr(CS%KE_adv,isd,ied,jsd,jed,nz) + if (CS%id_KE_adv > 0) allocate(CS%KE_adv(isd:ied,jsd:jed,nz), source=0.) CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_visc>0) call safe_alloc_ptr(CS%KE_visc,isd,ied,jsd,jed,nz) + if (CS%id_KE_visc > 0) allocate(CS%KE_visc(isd:ied,jsd:jed,nz), source=0.) CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_stress>0) call safe_alloc_ptr(CS%KE_stress,isd,ied,jsd,jed,nz) + if (CS%id_KE_stress > 0) allocate(CS%KE_stress(isd:ied,jsd:jed,nz), source=0.) CS%id_KE_horvisc = register_diag_field('ocean_model', 'KE_horvisc', diag%axesTL, Time, & 'Kinetic Energy Source from Horizontal Viscosity', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_horvisc>0) call safe_alloc_ptr(CS%KE_horvisc,isd,ied,jsd,jed,nz) + if (CS%id_KE_horvisc > 0) allocate(CS%KE_horvisc(isd:ied,jsd:jed,nz), source=0.) if (.not. adiabatic) then CS%id_KE_dia = register_diag_field('ocean_model', 'KE_dia', diag%axesTL, Time, & 'Kinetic Energy Source from Diapycnal Diffusion', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_dia>0) call safe_alloc_ptr(CS%KE_dia,isd,ied,jsd,jed,nz) + if (CS%id_KE_dia > 0) allocate(CS%KE_dia(isd:ied,jsd:jed,nz), source=0.) endif ! gravity wave CFLs @@ -1954,13 +1939,12 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) !### call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018) - call safe_alloc_ptr(CS%cg1,isd,ied,jsd,jed) - if (CS%id_Rd1>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) - if (CS%id_Rd_ebt>0) call safe_alloc_ptr(CS%Rd1,isd,ied,jsd,jed) - if (CS%id_cfl_cg1>0) call safe_alloc_ptr(CS%cfl_cg1,isd,ied,jsd,jed) - if (CS%id_cfl_cg1_x>0) call safe_alloc_ptr(CS%cfl_cg1_x,isd,ied,jsd,jed) - if (CS%id_cfl_cg1_y>0) call safe_alloc_ptr(CS%cfl_cg1_y,isd,ied,jsd,jed) - if (CS%id_p_ebt>0) call safe_alloc_ptr(CS%p_ebt,isd,ied,jsd,jed,nz) + allocate(CS%cg1(isd:ied,jsd:jed), source=0.) + if (CS%id_Rd1 > 0 .or. CS%id_Rd_ebt > 0) allocate(CS%Rd1(isd:ied,jsd:jed), source=0.) + if (CS%id_cfl_cg1 > 0) allocate(CS%cfl_cg1(isd:ied,jsd:jed), source=0.) + if (CS%id_cfl_cg1_x > 0) allocate(CS%cfl_cg1_x(isd:ied,jsd:jed), source=0.) + if (CS%id_cfl_cg1_y > 0) allocate(CS%cfl_cg1_y(isd:ied,jsd:jed), source=0.) + if (CS%id_p_ebt > 0) allocate(CS%p_ebt(isd:ied,jsd:jed,nz), source=0.) endif CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & @@ -2311,7 +2295,7 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) !! equation. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(diagnostics_CS), pointer :: CS !< Pointer to the control structure for this + type(diagnostics_CS), intent(inout) :: CS !< Pointer to the control structure for this !! module. ! This subroutine sets up diagnostics upon which other diagnostics depend. @@ -2319,49 +2303,50 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS%dKE_dt) .or. associated(CS%PE_to_KE) .or. & - associated(CS%KE_BT) .or. associated(CS%KE_CorAdv) .or. & - associated(CS%KE_adv) .or. associated(CS%KE_visc) .or. associated(CS%KE_stress) .or. & - associated(CS%KE_horvisc) .or. associated(CS%KE_dia)) & - call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) + if (allocated(CS%dKE_dt) .or. allocated(CS%PE_to_KE) .or. & + allocated(CS%KE_BT) .or. allocated(CS%KE_CorAdv) .or. & + allocated(CS%KE_adv) .or. allocated(CS%KE_visc) .or. allocated(CS%KE_stress) .or. & + allocated(CS%KE_horvisc) .or. allocated(CS%KE_dia)) then + if (.not. allocated(CS%KE)) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) + endif - if (associated(CS%dKE_dt)) then - if (.not.associated(CS%du_dt)) then - call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) + if (allocated(CS%dKE_dt)) then + if (.not. allocated(CS%du_dt)) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif - if (.not.associated(CS%dv_dt)) then - call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) + if (.not. allocated(CS%dv_dt)) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif - if (.not.associated(CS%dh_dt)) then - call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) + if (.not. allocated(CS%dh_dt)) then + allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif endif - if (associated(CS%KE_adv)) then + if (allocated(CS%KE_adv)) then call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_visc)) then + if (allocated(CS%KE_visc)) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_stress)) then + if (allocated(CS%KE_stress)) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_dia)) then + if (allocated(CS%KE_dia)) then call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) endif - if (associated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) - if (associated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) + if (allocated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) + if (allocated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) end subroutine set_dependent_diagnostics @@ -2375,26 +2360,26 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) !! equation. integer :: m - if (associated(CS%e)) deallocate(CS%e) - if (associated(CS%e_D)) deallocate(CS%e_D) - if (associated(CS%KE)) deallocate(CS%KE) - if (associated(CS%dKE_dt)) deallocate(CS%dKE_dt) - if (associated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) - if (associated(CS%KE_BT)) deallocate(CS%KE_BT) - if (associated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) - if (associated(CS%KE_adv)) deallocate(CS%KE_adv) - if (associated(CS%KE_visc)) deallocate(CS%KE_visc) - if (associated(CS%KE_stress)) deallocate(CS%KE_stress) - if (associated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) - if (associated(CS%KE_dia)) deallocate(CS%KE_dia) - if (associated(CS%dv_dt)) deallocate(CS%dv_dt) - if (associated(CS%dh_dt)) deallocate(CS%dh_dt) - if (associated(CS%du_dt)) deallocate(CS%du_dt) - if (associated(CS%h_Rlay)) deallocate(CS%h_Rlay) - if (associated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) - if (associated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) - if (associated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) - if (associated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) + if (allocated(CS%e)) deallocate(CS%e) + if (allocated(CS%e_D)) deallocate(CS%e_D) + if (allocated(CS%KE)) deallocate(CS%KE) + if (allocated(CS%dKE_dt)) deallocate(CS%dKE_dt) + if (allocated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) + if (allocated(CS%KE_BT)) deallocate(CS%KE_BT) + if (allocated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) + if (allocated(CS%KE_adv)) deallocate(CS%KE_adv) + if (allocated(CS%KE_visc)) deallocate(CS%KE_visc) + if (allocated(CS%KE_stress)) deallocate(CS%KE_stress) + if (allocated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) + if (allocated(CS%KE_dia)) deallocate(CS%KE_dia) + if (allocated(CS%dh_dt)) deallocate(CS%dh_dt) + if (allocated(CS%dv_dt)) deallocate(CS%dv_dt) + if (allocated(CS%du_dt)) deallocate(CS%du_dt) + if (allocated(CS%h_Rlay)) deallocate(CS%h_Rlay) + if (allocated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) + if (allocated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) + if (allocated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) + if (allocated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) if (associated(ADp%gradKEv)) deallocate(ADp%gradKEv) From c4fd89de58c4837e6a415e607923138cbb9b852a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 10 Nov 2021 10:18:27 -0500 Subject: [PATCH 055/138] set_visc_CS pointer removal Convert `set_visc_CS` pointer instances to locals --- src/core/MOM.F90 | 8 ++----- src/core/MOM_dynamics_split_RK2.F90 | 8 +++---- src/core/MOM_dynamics_unsplit.F90 | 9 +++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +++------ .../vertical/MOM_set_viscosity.F90 | 22 ++++--------------- 5 files changed, 15 insertions(+), 42 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 027127189d..72acebf88c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -351,7 +351,7 @@ module MOM !! This is also common referred to as Gent-McWilliams diffusion type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp !< Pointer to the control structure used for the mixed layer restratification - type(set_visc_CS), pointer :: set_visc_CSp => NULL() + type(set_visc_CS) :: set_visc_CSp !< Pointer to the control structure used to set viscosities type(diabatic_CS), pointer :: diabatic_CSp => NULL() !< Pointer to the control structure for the diabatic driver @@ -3609,12 +3609,8 @@ subroutine MOM_end(CS) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) - call VarMix_end(CS%VarMix) - - if (associated(CS%set_visc_CSp)) & - call set_visc_end(CS%visc, CS%set_visc_CSp) - + call set_visc_end(CS%visc, CS%set_visc_CSp) call MEKE_end(CS%MEKE) if (associated(CS%tv%internal_heat)) deallocate(CS%tv%internal_heat) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 1a8e68bc8d..416333853b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1230,7 +1230,7 @@ end subroutine register_restarts_dyn_split_RK2 subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, thickness_diffuse_CSp, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, calc_dtbt, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1264,7 +1264,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure - type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control structure type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related type(directories), intent(in) :: dirs !< contains directory paths integer, target, intent(inout) :: ntrunc !< A target for the variable that records @@ -1395,9 +1395,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_split_RK2 called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc call updateCFLtruncationValue(Time, CS%vertvisc_CSp, & activate=is_new_run(restart_CS) ) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6e2dfaad31..c0137fcd82 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -546,7 +546,7 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & Accel_diag, Cont_diag, MIS, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -581,8 +581,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS !! the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE control !! structure. - type(set_visc_CS), pointer :: setVisc_CSp !< This points to the set_visc - !! control structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control struct type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities, bottom drag !! viscosities, and related fields. @@ -651,9 +650,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_unsplit called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) CS%OBC => OBC diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 4cbedafd6f..9d2a3cf3a2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -494,7 +494,7 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & Accel_diag, Cont_diag, MIS, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + OBC, update_OBC_CSp, ALE_CSp, set_visc, & visc, dirs, ntrunc, cont_stencil) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -526,9 +526,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag !! to the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE !! control structure. - type(set_visc_CS), pointer :: setVisc_CSp !< This points to the - !! set_visc control - !! structure. + type(set_visc_CS), target, intent(in) :: set_visc !< set visc control struct type(vertvisc_type), intent(inout) :: visc !< A structure containing !! vertical viscosities, bottom drag !! viscosities, and related fields. @@ -613,9 +611,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) - if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & - "initialize_dyn_unsplit_RK2 called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp + CS%set_visc_CSp => set_visc if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) CS%OBC => OBC diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 902c22240b..75fcb04831 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -130,7 +130,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) !! have NULL ptrs.. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. ! Local variables @@ -284,8 +284,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& - "Module must be initialized before it is used.") if (.not.CS%bottomdraglaw) return if (CS%debug) then @@ -1144,7 +1142,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. real, intent(in) :: dt !< Time increment [T ~> s]. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. ! Local variables @@ -1247,8 +1245,6 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) Isq = G%isc-1 ; Ieq = G%IecB ; Jsq = G%jsc-1 ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml - if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(visc_ML): "//& - "Module must be initialized before it is used.") if (.not.(CS%dynamic_viscous_ML .or. associated(forces%frac_shelf_u) .or. & associated(forces%frac_shelf_v)) ) return @@ -1896,8 +1892,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! output. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. Allocated here. - type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control struct type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure @@ -1932,13 +1927,6 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS # include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "set_visc_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - CS%OBC => OBC is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2242,7 +2230,7 @@ end subroutine set_visc_init subroutine set_visc_end(visc, CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. Elements are deallocated here. - type(set_visc_CS), pointer :: CS !< The control structure returned by a previous + type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. if (CS%bottomdraglaw) then deallocate(visc%bbl_thick_u) ; deallocate(visc%bbl_thick_v) @@ -2269,8 +2257,6 @@ subroutine set_visc_end(visc, CS) if (associated(visc%tbl_thick_shelf_v)) deallocate(visc%tbl_thick_shelf_v) if (associated(visc%kv_tbl_shelf_u)) deallocate(visc%kv_tbl_shelf_u) if (associated(visc%kv_tbl_shelf_v)) deallocate(visc%kv_tbl_shelf_v) - - deallocate(CS) end subroutine set_visc_end !> \namespace mom_set_visc From 62edfdbf2431006717c6030cd82f4cc5c7c38ac1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 11 Nov 2021 11:51:59 -0500 Subject: [PATCH 056/138] tidal_bay_obc_cs pointer removal --- src/core/MOM_boundary_update.F90 | 9 ++++----- src/user/tidal_bay_initialization.F90 | 22 +++------------------- 2 files changed, 7 insertions(+), 24 deletions(-) diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index dc89f3f92c..286cec20d4 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -19,7 +19,7 @@ module MOM_boundary_update use MOM_verticalGrid, only : verticalGrid_type use DOME_initialization, only : register_DOME_OBC use tidal_bay_initialization, only : tidal_bay_set_OBC_data, register_tidal_bay_OBC -use tidal_bay_initialization, only : tidal_bay_OBC_end, tidal_bay_OBC_CS +use tidal_bay_initialization, only : tidal_bay_OBC_CS use Kelvin_initialization, only : Kelvin_set_OBC_data, register_Kelvin_OBC use Kelvin_initialization, only : Kelvin_OBC_end, Kelvin_OBC_CS use shelfwave_initialization, only : shelfwave_set_OBC_data, register_shelfwave_OBC @@ -44,7 +44,7 @@ module MOM_boundary_update !>@{ Pointers to the control structures for named OBC specifications type(file_OBC_CS), pointer :: file_OBC_CSp => NULL() type(Kelvin_OBC_CS), pointer :: Kelvin_OBC_CSp => NULL() - type(tidal_bay_OBC_CS), pointer :: tidal_bay_OBC_CSp => NULL() + type(tidal_bay_OBC_CS) :: tidal_bay_OBC type(shelfwave_OBC_CS), pointer :: shelfwave_OBC_CSp => NULL() type(dyed_channel_OBC_CS), pointer :: dyed_channel_OBC_CSp => NULL() !>@} @@ -118,7 +118,7 @@ subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg) endif if (CS%use_tidal_bay) CS%use_tidal_bay = & - register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC_CSp, US, & + register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC, US, & OBC%OBC_Reg) if (CS%use_Kelvin) CS%use_Kelvin = & register_Kelvin_OBC(param_file, CS%Kelvin_OBC_CSp, US, & @@ -147,7 +147,7 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) ! if (CS%use_files) & ! call update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (CS%use_tidal_bay) & - call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC_CSp, G, GV, h, Time) + call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC, G, GV, h, Time) if (CS%use_Kelvin) & call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, GV, US, h, Time) if (CS%use_shelfwave) & @@ -164,7 +164,6 @@ subroutine OBC_register_end(CS) type(update_OBC_CS), pointer :: CS !< Control structure for OBCs if (CS%use_files) call file_OBC_end(CS%file_OBC_CSp) - if (CS%use_tidal_bay) call tidal_bay_OBC_end(CS%tidal_bay_OBC_CSp) if (CS%use_Kelvin) call Kelvin_OBC_end(CS%Kelvin_OBC_CSp) if (associated(CS)) deallocate(CS) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 136e5f9eee..51772e2f9f 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -20,7 +20,7 @@ module tidal_bay_initialization #include -public tidal_bay_set_OBC_data, tidal_bay_OBC_end +public tidal_bay_set_OBC_data public register_tidal_bay_OBC !> Control structure for tidal bay open boundaries. @@ -33,20 +33,13 @@ module tidal_bay_initialization !> Add tidal bay to OBC registry. function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. + type(tidal_bay_OBC_CS), intent(inout) :: CS !< tidal bay control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. logical :: register_tidal_bay_OBC character(len=32) :: casename = "tidal bay" !< This case's name. character(len=40) :: mdl = "tidal_bay_initialization" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "register_tidal_bay_OBC called with an "// & - "associated control structure.") - return - endif - allocate(CS) - call get_param(param_file, mdl, "TIDAL_BAY_FLOW", CS%tide_flow, & "Maximum total tidal volume flux.", & units="m3 s-1", default=3.0e6, scale=US%m_s_to_L_T*US%m_to_L*US%m_to_Z) @@ -57,21 +50,12 @@ function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) end function register_tidal_bay_OBC -!> Clean up the tidal bay OBC from registry. -subroutine tidal_bay_OBC_end(CS) - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. - - if (associated(CS)) then - deallocate(CS) - endif -end subroutine tidal_bay_OBC_end - !> This subroutine sets the properties of flow at open boundary conditions. subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. - type(tidal_bay_OBC_CS), pointer :: CS !< tidal bay control structure. + type(tidal_bay_OBC_CS), intent(in) :: CS !< tidal bay control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] From c4df74852b9d7a76fddf188a7ced4b69da33b115 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 11 Nov 2021 13:47:20 -0500 Subject: [PATCH 057/138] Equation of state pointer removal * `EOS_type` pointers in MOM_EOS_mod moved to locals * Various `EOS_type` pointers changed to local * `eqn_of_state` removed from the following: - `adjustment_initialize_temperature_salinity` - `BFB_set_coord` - `dense_water_initialize_TS` - `DOME2d_initialize_temperature_salinity` - `dumbbell_initialize_temperature_salinity` - `Neverworld_initialize_thickness` - `Rossby_front_initialize_temperature_salinity` - `seamount_initialize_temperature_salinity` - `sloshing_initialize_temperature_salinity` - `USER_initialize_temperature_salinity` - `USER_set_coord` * `EOS` removed from neutral diffusion unit test NOTE: eqn_of_state in MOM_mod is retained, since there are many checks of pointer associated of `tv%eqn_of_state`. --- src/ALE/coord_hycom.F90 | 2 +- src/ALE/coord_rho.F90 | 4 +- src/ALE/coord_slight.F90 | 2 +- src/core/MOM.F90 | 5 +- src/core/MOM_density_integrals.F90 | 18 +-- src/equation_of_state/MOM_EOS.F90 | 150 ++++-------------- src/framework/MOM_diag_remap.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- .../MOM_coord_initialization.F90 | 19 +-- .../MOM_state_initialization.F90 | 22 +-- src/tracer/MOM_neutral_diffusion.F90 | 1 - src/tracer/MOM_tracer_Z_init.F90 | 12 +- src/user/BFB_initialization.F90 | 5 +- src/user/DOME2d_initialization.F90 | 5 +- src/user/ISOMIP_initialization.F90 | 2 +- src/user/Neverworld_initialization.F90 | 3 +- src/user/Rossby_front_2d_initialization.F90 | 3 +- src/user/adjustment_initialization.F90 | 4 +- src/user/benchmark_initialization.F90 | 4 +- src/user/dense_water_initialization.F90 | 3 +- src/user/dumbbell_initialization.F90 | 4 +- src/user/seamount_initialization.F90 | 4 +- src/user/sloshing_initialization.F90 | 4 +- src/user/user_initialization.F90 | 6 +- 24 files changed, 88 insertions(+), 198 deletions(-) diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 016e4016eb..4d70f925aa 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -98,7 +98,7 @@ end subroutine set_hycom_params subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & z_col, z_col_new, zScale, h_neglect, h_neglect_edge) type(hycom_CS), intent(in) :: CS !< Coordinate control structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) real, dimension(nz), intent(in) :: T !< Temperature of column [degC] diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 6c9934ce38..4a9872d429 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -95,7 +95,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(nz), intent(in) :: T !< Temperature for source column [degC] real, dimension(nz), intent(in) :: S !< Salinity for source column [ppt] - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(CS%nk+1), & intent(inout) :: z_interface !< Absolute positions of interfaces real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (positive upward in the same @@ -208,7 +208,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ real, dimension(nz), intent(in) :: h !< Layer thicknesses in Z coordinates [Z ~> m] real, dimension(nz), intent(in) :: T !< T for column [degC] real, dimension(nz), intent(in) :: S !< S for column [ppt] - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, dimension(nz+1), intent(inout) :: zInterface !< Absolute positions of interfaces real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 5cfa09213f..23a390456e 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -181,7 +181,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & nz, depth, h_col, T_col, S_col, p_col, z_col, z_col_new, & h_neglect, h_neglect_edge) type(slight_CS), intent(in) :: CS !< Coordinate control structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: H_to_pres !< A conversion factor from thicknesses to !! scaled pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] real, intent(in) :: H_subroundoff !< GV%H_subroundoff diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 72acebf88c..3dc12c57e7 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2330,7 +2330,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Use the Wright equation of state by default, unless otherwise specified ! Note: this line and the following block ought to be in a separate ! initialization routine for tv. - if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state, US) + if (use_EOS) then + allocate(CS%tv%eqn_of_state) + call EOS_init(param_file, CS%tv%eqn_of_state, US) + endif if (use_temperature) then allocate(CS%tv%TempxPmE(isd:ied,jsd:jed), source=0.0) if (use_geothermal) then diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index c4791de53c..9fb4fdabcc 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -56,7 +56,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly @@ -113,7 +113,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly @@ -364,7 +364,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] @@ -806,7 +806,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa] @@ -1137,7 +1137,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, US, & !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of !! alpha_ref, but this reduces the effects of roundoff. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly across @@ -1196,7 +1196,7 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d !! The calculation is mathematically identical with different values of !! alpha_ref, but alpha_ref alters the effects of roundoff, and !! answers do change. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly @@ -1419,7 +1419,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, !! the same units as p_t [R L2 T-2 ~> Pa] or [Pa] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyP !< The pressure at the bathymetry [R L2 T-2 ~> Pa] or [Pa] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(HI),SZJ_(HI)), & intent(inout) :: dza !< The change in the geopotential anomaly @@ -1657,7 +1657,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t real, intent(in) :: rho_ref !< Reference density with which calculation !! are anomalous to [R ~> kg m-3] real, intent(in) :: G_e !< Gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: P_b !< Pressure at the bottom of the cell [R L2 T-2 ~> Pa] real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m] @@ -1736,7 +1736,7 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO !! reduce the magnitude of each of the integrals. real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: pos !< The fractional vertical position, 0 to 1 [nondim] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real :: fract_dp_at_pos !< The change in pressure from the layer top to !! fractional position pos [R L2 T-2 ~> Pa] ! Local variables diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e1b7b200d2..39b626985a 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -37,9 +37,7 @@ module MOM_EOS #include -public EOS_allocate public EOS_domain -public EOS_end public EOS_init public EOS_manual_init public EOS_quadrature @@ -167,7 +165,7 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density in !! combination with scaling given by US [various] @@ -175,9 +173,6 @@ subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref, scale) real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_scalar called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -216,7 +211,7 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, intent(in) :: Svar !< Variance of salinity [ppt2] real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! from kg m-3 to the desired units [R m3 kg-1] @@ -225,9 +220,6 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_stanley_density_scalar called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -266,15 +258,12 @@ subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_re real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [kg m-3] or [R ~> kg m-3] integer, intent(in) :: start !< Start index for computation integer, intent(in) :: npts !< Number of point to compute - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_linear(T, S, pressure, rho, start, npts, & @@ -312,7 +301,7 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [kg m-3] integer, intent(in) :: start !< Start index for computation integer, intent(in) :: npts !< Number of point to compute - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! from kg m-3 to the desired units [R m3 kg-1] @@ -320,9 +309,6 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_linear(T, S, pressure, rho, start, npts, & @@ -361,7 +347,7 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] @@ -375,9 +361,6 @@ subroutine calculate_density_1d(T, S, pressure, rho, EOS, dom, rho_ref, scale) real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -421,7 +404,7 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, dimension(:), intent(in) :: TScov !< Covariance of potential temperature and salinity [degC ppt] real, dimension(:), intent(in) :: Svar !< Variance of salinity [ppt2] real, dimension(:), intent(inout) :: rho !< Density (in-situ if pressure is local) [R ~> kg m-3] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3] @@ -434,9 +417,6 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -489,7 +469,7 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s real, dimension(:), intent(inout) :: specvol !< in situ specific volume [kg m-3] integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -497,9 +477,6 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s real, dimension(size(specvol)) :: rho ! Density [kg m-3] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_spec_vol_linear(T, S, pressure, specvol, start, npts, & @@ -534,7 +511,7 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] or [R L2 T-2 ~> Pa] real, intent(out) :: specvol !< In situ? specific volume [m3 kg-1] or [R-1 ~> m3 kg-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1] or [R-1 m3 kg-1] real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling given by US [various] @@ -543,9 +520,6 @@ subroutine calc_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref, scale) real :: spv_reference ! spv_ref converted to [m3 kg-1] real :: spv_scale ! A factor to convert specific volume from m3 kg-1 to the desired units [kg R-1 m-3 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calc_spec_vol_scalar called with an unassociated EOS_type EOS.") - pres(1) = EOS%RL2_T2_to_Pa*pressure Ta(1) = T ; Sa(1) = S @@ -572,7 +546,7 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) real, dimension(:), intent(in) :: S !< Salinity [ppt] real, dimension(:), intent(in) :: pressure !< Pressure [R L2 T-2 ~> Pa] real, dimension(:), intent(inout) :: specvol !< In situ specific volume [R-1 ~> m3 kg-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: spv_ref !< A reference specific volume [R-1 ~> m3 kg-1] @@ -587,9 +561,6 @@ subroutine calc_spec_vol_1d(T, S, pressure, specvol, EOS, dom, spv_ref, scale) real :: spv_reference ! spv_ref converted to [m3 kg-1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calc_spec_vol_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -626,15 +597,12 @@ subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale) real, intent(in) :: pressure !< Pressure [Pa] or [other] real, intent(out) :: T_fr !< Freezing point potential temperature referenced !! to the surface [degC] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa ! Local variables real :: p_scale ! A factor to convert pressure to units of Pa. - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale select case (EOS%form_of_TFreeze) @@ -659,7 +627,7 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca !! to the surface [degC] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure into Pa. ! Local variables @@ -667,9 +635,6 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca real :: p_scale ! A factor to convert pressure to units of Pa. integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_TFreeze_scalar called with an unassociated EOS_type EOS.") - p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale if (p_scale == 1.0) then @@ -712,16 +677,13 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & @@ -755,7 +717,7 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do !! temperature [R degC-1 ~> kg m-3 degC-1] real, dimension(:), intent(inout) :: drho_dS !< The partial derivative of density with salinity !! [R ppt-1 ~> kg m-3 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density @@ -766,9 +728,6 @@ subroutine calculate_density_derivs_1d(T, S, pressure, drho_dT, drho_dS, EOS, do real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -804,7 +763,7 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS !! temperature [kg m-3 degC-1] or [R degC-1 ~> kg m-3 degC-1] real, intent(out) :: drho_dS !< The partial derivative of density with salinity, !! in [kg m-3 ppt-1] or [R ppt-1 ~> kg m-3 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -812,9 +771,6 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -856,7 +812,7 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -866,9 +822,6 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa if (p_scale == 1.0) then @@ -938,7 +891,7 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! [kg m-3 ppt-1 Pa-1] or [R ppt-1 Pa-1 ~> kg m-3 ppt-1 Pa-1] real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure !! [kg m-3 degC-1 Pa-1] or [R degC-1 Pa-1 ~> kg m-3 degC-1 Pa-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: scale !< A multiplicative factor by which to scale density !! in combination with scaling given by US [various] ! Local variables @@ -946,9 +899,6 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: I_p_scale ! The inverse of the factor to convert pressure to units of Pa [R L2 T-2 Pa-1 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_density_derivs called with an unassociated EOS_type EOS.") - p_scale = EOS%RL2_T2_to_Pa select case (EOS%form_of_EOS) @@ -994,7 +944,7 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start !! [m3 kg-1 ppt-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(size(T)) :: press ! Pressure converted to [Pa] @@ -1003,9 +953,6 @@ subroutine calculate_spec_vol_derivs_array(T, S, pressure, dSV_dT, dSV_dS, start real, dimension(size(T)) :: dRho_dS ! Derivative of density with salinity [kg m-3 ppt-1] integer :: j - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_derivs_array called with an unassociated EOS_type EOS.") - select case (EOS%form_of_EOS) case (EOS_LINEAR) call calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, start, & @@ -1044,7 +991,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca !! temperature [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(:), intent(inout) :: dSV_dS !< The partial derivative of specific volume with salinity !! [R-1 ppt-1 ~> m3 kg-1 ppt-1] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, dimension(2), optional, intent(in) :: dom !< The domain of indices to work on, taking !! into account that arrays start at 1. real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific @@ -1056,9 +1003,6 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: i, is, ie, npts - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_spec_vol_derivs_1d called with an unassociated EOS_type EOS.") - if (present(dom)) then is = dom(1) ; ie = dom(2) ; npts = 1 + ie - is else @@ -1095,15 +1039,12 @@ subroutine calculate_compress_array(T, S, press, rho, drho_dp, start, npts, EOS) !! [s2 m-2] or [T2 L-2] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(size(press)) :: pressure ! Pressure converted to [Pa] integer :: i, is, ie - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_compress called with an unassociated EOS_type EOS.") - is = start ; ie = is + npts - 1 do i=is,ie ; pressure(i) = EOS%RL2_T2_to_Pa * press(i) ; enddo @@ -1142,13 +1083,11 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) real, intent(out) :: rho !< In situ density [kg m-3] or [R ~> kg m-3] real, intent(out) :: drho_dp !< The partial derivative of density with pressure (also the !! inverse of the square of sound speed) [s2 m-2] or [T2 L-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa - if (.not.associated(EOS)) call MOM_error(FATAL, & - "calculate_compress called with an unassociated EOS_type EOS.") Ta(1) = T ; Sa(1) = S; pa(1) = pressure call calculate_compress_array(Ta, Sa, pa, rhoa, drho_dpa, 1, 1, EOS) @@ -1198,7 +1137,7 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! to reduce the magnitude of each of the integrals [R-1 ~> m3 kg-1] !! The calculation is mathematically identical with different values of !! alpha_ref, but this reduces the effects of roundoff. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dza !< The change in the geopotential anomaly across !! the layer [L2 T-2 ~> m2 s-2] or [m2 s-2] @@ -1226,9 +1165,6 @@ subroutine analytic_int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & real :: SV_scale ! A multiplicative factor by which to scale specific ! volume from m3 kg-1 to the desired units [kg m-3 R-1 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "int_specific_vol_dp called with an unassociated EOS_type EOS.") - ! We should never reach this point with quadrature. EOS_quadrature indicates that numerical ! integration be used instead of analytic. This is a safety check. if (EOS%EOS_quadrature) call MOM_error(FATAL, "EOS_quadrature is set!") @@ -1271,7 +1207,7 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration !! [L2 Z-1 T-2 ~> m s-2] or [m2 Z-1 s-2 ~> m s-2] - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(inout) :: dpa !< The change in the pressure anomaly !! across the layer [R L2 T-2 ~> Pa] or [Pa] @@ -1299,9 +1235,6 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, ! desired units [R m3 kg-1 ~> 1] real :: pres_scale ! A multiplicative factor to convert pressure into Pa [Pa T2 R-1 L-2 ~> 1] - if (.not.associated(EOS)) call MOM_error(FATAL, & - "int_density_dz called with an unassociated EOS_type EOS.") - ! We should never reach this point with quadrature. EOS_quadrature indicates that numerical ! integration be used instead of analytic. This is a safety check. if (EOS%EOS_quadrature) call MOM_error(FATAL, "EOS_quadrature is set!") @@ -1338,10 +1271,7 @@ end subroutine analytic_int_density_dz !> Returns true if the equation of state is compressible (i.e. has pressure dependence) logical function query_compressible(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "query_compressible called with an unassociated EOS_type EOS.") + type(EOS_type), intent(in) :: EOS !< Equation of state structure query_compressible = EOS%compressible end function query_compressible @@ -1349,7 +1279,7 @@ end function query_compressible !> Initializes EOS_type by allocating and reading parameters subroutine EOS_init(param_file, EOS, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(inout) :: EOS !< Equation of state structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type optional :: US ! Local variables @@ -1357,8 +1287,6 @@ subroutine EOS_init(param_file, EOS, US) character(len=40) :: mdl = "MOM_EOS" ! This module's name. character(len=40) :: tmpstr - if (.not.associated(EOS)) call EOS_allocate(EOS) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1457,7 +1385,7 @@ end subroutine EOS_init !> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS) subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(inout) :: EOS !< Equation of state structure integer, optional, intent(in) :: form_of_EOS !< A coded integer indicating the equation of state to use. integer, optional, intent(in) :: form_of_TFreeze !< A coded integer indicating the expression for !! the potential temperature of the freezing point. @@ -1488,20 +1416,6 @@ subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Co end subroutine EOS_manual_init -!> Allocates EOS_type -subroutine EOS_allocate(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) allocate(EOS) -end subroutine EOS_allocate - -!> Deallocates EOS_type -subroutine EOS_end(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (associated(EOS)) deallocate(EOS) -end subroutine EOS_end - !> Set equation of state structure (EOS) to linear with given coefficients !! !! \note This routine is primarily for testing and allows a local copy of the @@ -1513,10 +1427,7 @@ subroutine EOS_use_linear(Rho_T0_S0, dRho_dT, dRho_dS, EOS, use_quadrature) real, intent(in) :: dRho_dS !< Partial derivative of density with salinity [kg m-3 ppt-1] logical, optional, intent(in) :: use_quadrature !< If true, always use the generic (quadrature) !! code for the integrals of density. - type(EOS_type), pointer :: EOS !< Equation of state structure - - if (.not.associated(EOS)) call MOM_error(FATAL, & - "MOM_EOS.F90: EOS_use_linear() called with an unassociated EOS_type EOS.") + type(EOS_type), intent(inout) :: EOS !< Equation of state structure EOS%form_of_EOS = EOS_LINEAR EOS%Compressible = .false. @@ -1539,15 +1450,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) intent(inout) :: S !< Salinity [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(in) :: mask_z !< 3d mask regulating which points to convert. - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer :: i, j, k real :: gsw_sr_from_sp, gsw_ct_from_pt, gsw_sa_from_sp real :: p - if (.not.associated(EOS)) call MOM_error(FATAL, & - "convert_temp_salt_to_TEOS10 called with an unassociated EOS_type EOS.") - if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return do k=1,kd ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec @@ -1564,7 +1472,7 @@ end subroutine convert_temp_salt_for_TEOS10 !> Return value of EOS_quadrature logical function EOS_quadrature(EOS) - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure EOS_quadrature = EOS%EOS_quadrature @@ -1573,7 +1481,7 @@ end function EOS_quadrature !> Extractor routine for the EOS type if the members need to be accessed outside this module subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) - type(EOS_type), pointer :: EOS !< Equation of state structure + type(EOS_type), intent(in) :: EOS !< Equation of state structure integer, optional, intent(out) :: form_of_EOS !< A coded integer indicating the equation of state to use. integer, optional, intent(out) :: form_of_TFreeze !< A coded integer indicating the expression for !! the potential temperature of the freezing point. diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index bb11d92673..f9e5a35a09 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -280,7 +280,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe real, dimension(:,:,:), intent(in) :: h !< New thickness [H ~> m or kg m-2] real, dimension(:,:,:), intent(in) :: T !< New temperatures [degC] real, dimension(:,:,:), intent(in) :: S !< New salinities [ppt] - type(EOS_type), pointer :: eqn_of_state !< A pointer to the equation of state + type(EOS_type), intent(in) :: eqn_of_state !< A pointer to the equation of state real, dimension(:,:,:), intent(inout) :: h_target !< The new diagnostic thicknesses [H ~> m or kg m-2] ! Local variables diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index afcad4fb06..77166cece0 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -157,7 +157,7 @@ module MOM_ice_shelf real :: input_thickness !< Ice thickness at an upstream open boundary [m]. type(time_type) :: Time !< The component's time. - type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the + type(EOS_type) :: eqn_of_state !< Type that indicates the !! equation of state to use. logical :: active_shelf_dynamics !< True if the ice shelf mass changes as a result !! the dynamic ice-shelf model. diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 4f04fb285f..eb0db68726 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -48,9 +48,6 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept ! This include declares and sets the variable "version". #include "version_variable.h" integer :: nz - type(EOS_type), pointer :: eos => NULL() - - if (associated(tv%eqn_of_state)) eos => tv%eqn_of_state nz = GV%ke @@ -86,17 +83,17 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept case ("linear") call set_coord_linear(GV%Rlay, GV%g_prime, GV, US, PF) case ("ts_ref") - call set_coord_from_TS_ref(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_ref(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("ts_profile") - call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("ts_range") - call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) + call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, tv%eqn_of_state, tv%P_Ref) case ("file") call set_coord_from_file(GV%Rlay, GV%g_prime, GV, US, PF) case ("USER") - call user_set_coord(GV%Rlay, GV%g_prime, GV, US, PF, eos) + call user_set_coord(GV%Rlay, GV%g_prime, GV, US, PF) case ("BFB") - call BFB_set_coord(GV%Rlay, GV%g_prime, GV, US, PF, eos) + call BFB_set_coord(GV%Rlay, GV%g_prime, GV, US, PF) case ("none", "ALE") call set_coord_to_none(GV%Rlay, GV%g_prime, GV, US, PF) case default ; call MOM_error(FATAL,"MOM_initialize_coord: "// & @@ -208,7 +205,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state !! [L2 Z-1 T-2 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. @@ -258,7 +255,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s !! interface [L2 Z-1 T-2 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. @@ -305,7 +302,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta !! interface [L2 Z-1 T-2 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6a4d4195d5..37acb8ca42 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -309,8 +309,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & just_read=just_read) case ("benchmark"); call benchmark_initialize_thickness(h, depth_tot, G, GV, US, PF, & tv%eqn_of_state, tv%P_Ref, just_read=just_read) - case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, depth_tot, G, GV, US, PF, & - tv%eqn_of_state, tv%P_Ref) + case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, depth_tot, & + G, GV, US, PF, tv%P_Ref) case ("search"); call initialize_thickness_search() case ("circle_obcs"); call circle_obcs_initialize_thickness(h, depth_tot, G, GV, PF, & just_read=just_read) @@ -375,26 +375,26 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, GV, PF, & just_read=just_read) case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & tv%S, h, depth_tot, G, GV, US, PF, eos, just_read=just_read) case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & - tv%S, h, depth_tot, G, GV, PF, eos, just_read=just_read) + tv%S, h, depth_tot, G, GV, PF, just_read=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & tv%S, h, depth_tot, G, GV, US, PF, just_read=just_read) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read=just_read) + tv%S, h, G, GV, PF, just_read=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, h, & G, GV, US, PF, just_read=just_read) - case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & + case ("dense"); call dense_water_initialize_TS(G, GV, PF, tv%T, tv%S, & h, just_read=just_read) - case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, eos, & + case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, GV, PF, & just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized Temp & salt configuration "//trim(config)) @@ -1584,7 +1584,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! [R L2 T-2 ~> Pa]. logical, intent(in) :: just_read !< If true, this call will only read diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 05909cb8fc..a06af6cd57 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -2390,7 +2390,6 @@ logical function ndiff_unit_tests_discontinuous(verbose) real, dimension(ns) :: PoL, PoR real, dimension(ns-1) :: hEff, Flx type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure - type(EOS_type), pointer :: EOS !< Structure for linear equation of state type(remapping_CS), pointer :: remap_CS !< Remapping control structure (PLM) real, dimension(nk,2) :: ppoly_T_l, ppoly_T_r ! Linear reconstruction for T real, dimension(nk,2) :: ppoly_S_l, ppoly_S_r ! Linear reconstruction for S diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index cd6572cc9c..1be976d3f2 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -559,7 +559,7 @@ end function find_limited_slope !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, k_start, G, GV, US, & - eos, h_massless) + EOS, h_massless) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -575,7 +575,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, intent(in) :: h !< layer thickness, used only to avoid working on !! massless layers [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(eos_type), pointer :: eos !< seawater equation of state control structure + type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure real, optional, intent(in) :: h_massless !< A threshold below which a layer is !! determined to be massless [H ~> m or kg m-2] @@ -627,9 +627,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, adjust_salt = .true. iter_loop: do itt = 1,niter do k=1,nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, EOSdom ) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), EOS, EOSdom ) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & - eos, EOSdom ) + EOS, EOSdom ) enddo do k=k_start,nz ; do i=is,ie ! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln) then @@ -656,9 +656,9 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, if (adjust_salt .and. old_fit) then ; do itt = 1,niter do k=1,nz - call calculate_density(T(:,k), S(:,k), press, rho(:,k), eos, EOSdom ) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), EOS, EOSdom ) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & - eos, EOSdom ) + EOS, EOSdom ) enddo do k=k_start,nz ; do i=is,ie ! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln ) then diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 49c0a03235..922ae60fc5 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -35,15 +35,14 @@ module BFB_initialization !! This case is set up in such a way that the temperature of the topmost layer is equal to the SST at the !! southern edge of the domain. The temperatures are then converted to densities of the top and bottom layers !! and linearly interpolated for the intermediate layers. -subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) +subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(GV%ke), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(GV%ke+1), intent(out) :: g_prime !< The reduced gravity at each !! interface [L2 Z-1 T-2 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure - ! Local variables + real :: drho_dt, SST_s, T_bot, rho_top, rho_bot integer :: k, nz character(len=40) :: mdl = "BFB_set_coord" ! This subroutine's name. diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index bc689b112e..42279be8e3 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -220,19 +220,16 @@ end subroutine DOME2d_initialize_thickness !> Initialize temperature and salinity in the 2d DOME configuration -subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read) +subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. - ! Local variables integer :: i, j, k, is, ie, js, je, nz real :: x integer :: index_bay_z diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 580fab1ac6..5fe228e278 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -258,7 +258,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The nominal total bottom-to-top !! depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index 3f5b8c8ab2..5d992b572f 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -239,7 +239,7 @@ end function circ_ridge !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, eqn_of_state, P_ref) +subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, P_ref) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -250,7 +250,6 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. ! Local variables diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index d7af8af0e4..c35386a2fe 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -107,14 +107,13 @@ end subroutine Rossby_front_initialize_thickness !> Initialization of temperature and salinity in the Rossby front test subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & - param_file, eqn_of_state, just_read) + param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index c39561513c..934536d1f8 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -190,8 +190,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, & - eqn_of_state, just_read) +subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized. @@ -201,7 +200,6 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state. logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T & S. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index e0dc87c96e..b955f75a32 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -93,7 +93,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. logical, intent(in) :: just_read !< If true, this call will @@ -224,7 +224,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for !! model parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure [R L2 T-2 ~> Pa]. logical, intent(in) :: just_read !< If true, this call will only read diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 9169b27a06..99836f5ad0 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -95,11 +95,10 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) end subroutine dense_water_initialize_topography !> Initialize the temperature and salinity for the dense water experiment -subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, just_read) +subroutine dense_water_initialize_TS(G, GV, param_file, T, S, h, just_read) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< EOS structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 6bc3dd67af..ac4181d570 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -206,15 +206,13 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, end subroutine dumbbell_initialize_thickness !> Initial values for temperature and salinity for the dumbbell test case -subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read) +subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 20e42de41b..3dba7bfe59 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -189,15 +189,13 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j end subroutine seamount_initialize_thickness !> Initial values for temperature and salinity -subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read) +subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 0c1cf59df8..3bafdb2d02 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -176,8 +176,7 @@ end subroutine sloshing_initialize_thickness !! reference surface layer salinity and temperature and a specified range. !! Note that the linear distribution is set up with respect to the layer !! number, not the physical position). -subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read) +subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. @@ -186,7 +185,6 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure. logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 915be87e8a..d719e5867c 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -37,7 +37,7 @@ module user_initialization contains !> Set vertical coordinates. -subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) +subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(GV%ke), intent(out) :: Rlay !< Layer potential density [R ~> kg m-3]. real, dimension(GV%ke+1), intent(out) :: g_prime !< The reduced gravity at each @@ -46,7 +46,6 @@ subroutine USER_set_coord(Rlay, g_prime, GV, US, param_file, eqn_of_state) type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure call MOM_error(FATAL, & "USER_initialization.F90, USER_set_coord: " // & @@ -128,7 +127,7 @@ end subroutine USER_initialize_velocity !> This function puts the initial layer temperatures and salinities !! into T(:,:,:) and S(:,:,:). -subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, just_read) +subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC]. @@ -136,7 +135,6 @@ subroutine USER_init_temperature_salinity(T, S, G, GV, param_file, eqn_of_state, type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, intent(in) :: just_read !< If true, this call will only !! read parameters without changing T & S. From 4ee4dc595deb098cc6f455ebf30acdd52066cc86 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 12 Nov 2021 22:20:36 -0500 Subject: [PATCH 058/138] CoriolisAdv_CS pointer removal Redefine Coriolis advection pointers as locals --- src/core/MOM_CoriolisAdv.F90 | 14 +++----------- src/core/MOM_dynamics_split_RK2.F90 | 13 ++++++------- src/core/MOM_dynamics_unsplit.F90 | 10 +++++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +++++----- 4 files changed, 19 insertions(+), 28 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 3a3ba6920c..08deeb7d0e 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -134,7 +134,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -245,8 +245,6 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! v(is-1:ie+2,js-1:je+1), u(is-1:ie+1,js-1:je+2), h(is-1:ie+2,js-1:je+2), ! uh(is-1,ie,js:je+1) and vh(is:ie+1,js-1:je). - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_CoriolisAdv: Module must be initialized before it is used.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke vol_neglect = GV%H_subroundoff * (1e-4 * US%m_to_L)**2 @@ -1034,7 +1032,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. @@ -1113,7 +1111,7 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(accel_diag_ptrs), target, intent(inout) :: AD !< Strorage for acceleration diagnostics - type(CoriolisAdv_CS), pointer :: CS !< Control structure fro MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure fro MOM_CoriolisAdv ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1125,12 +1123,6 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then - call MOM_error(WARNING, "CoriolisAdv_init called with associated control structure.") - return - endif - allocate(CS) - CS%diag => diag ; CS%Time => Time ! Read all relevant parameters and write them to the model log. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 416333853b..74e0b8f33d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -202,8 +202,8 @@ module MOM_dynamics_split_RK2 type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() - !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + !> The CoriolisAdv control structure + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() !> A pointer to a structure containing interface height diffusivities @@ -478,7 +478,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv_CSp) + G, Gv, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -731,7 +731,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -1388,7 +1388,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) @@ -1698,8 +1698,7 @@ subroutine end_dyn_split_RK2(CS) call tidal_forcing_end(CS%tides_CSp) - call CoriolisAdv_end(CS%CoriolisAdv_Csp) - deallocate(CS%CoriolisAdv_CSp) + call CoriolisAdv_end(CS%CoriolisAdv) call continuity_end(CS%continuity_CSp) deallocate(CS%continuity_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index c0137fcd82..fb457b1652 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -145,7 +145,7 @@ module MOM_dynamics_unsplit !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() !> A pointer to the vertvisc control structure @@ -297,7 +297,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -363,7 +363,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -441,7 +441,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -643,7 +643,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 9d2a3cf3a2..72614ab3e0 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -146,8 +146,8 @@ module MOM_dynamics_unsplit_RK2 type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure type(continuity_CS), pointer :: continuity_CSp => NULL() - !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + !> The CoriolisAdv control structure + type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() !> A pointer to the vertvisc control structure @@ -291,7 +291,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) (function of h[n-1/2]) @@ -361,7 +361,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, GV, CS%CAu, CS%CAv) @@ -604,7 +604,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) From dc9adeb0237229c32d257ce2c145bf646b326a6a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sun, 14 Nov 2021 22:18:20 -0500 Subject: [PATCH 059/138] PressureForce CS pointer removal * The following control structures were moved to locals: * `PressureForce_CS` * `PressureForce_FV_CS` * `PressureForce_Mont_CS` * The `*_end()` functions no longer do anything and were removed --- src/core/MOM_PressureForce.F90 | 44 ++++++--------------- src/core/MOM_PressureForce_FV.F90 | 26 ++---------- src/core/MOM_PressureForce_Montgomery.F90 | 48 +++++++---------------- src/core/MOM_dynamics_split_RK2.F90 | 9 +---- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- 6 files changed, 35 insertions(+), 96 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 0ac1eb1ae1..844d9db4bc 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -8,10 +8,10 @@ module MOM_PressureForce use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_PressureForce_FV, only : PressureForce_FV_Bouss, PressureForce_FV_nonBouss -use MOM_PressureForce_FV, only : PressureForce_FV_init, PressureForce_FV_end +use MOM_PressureForce_FV, only : PressureForce_FV_init use MOM_PressureForce_FV, only : PressureForce_FV_CS use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss -use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end +use MOM_PressureForce_Mont, only : PressureForce_Mont_init use MOM_PressureForce_Mont, only : PressureForce_Mont_CS use MOM_tidal_forcing, only : tidal_forcing_CS use MOM_unit_scaling, only : unit_scale_type @@ -22,16 +22,16 @@ module MOM_PressureForce #include -public PressureForce, PressureForce_init, PressureForce_end +public PressureForce, PressureForce_init !> Pressure force control structure type, public :: PressureForce_CS ; private logical :: Analytic_FV_PGF !< If true, use the analytic finite volume form !! (Adcroft et al., Ocean Mod. 2008) of the PGF. !> Control structure for the analytically integrated finite volume pressure force - type(PressureForce_FV_CS), pointer :: PressureForce_FV_CSp => NULL() + type(PressureForce_FV_CS) :: PressureForce_FV !> Control structure for the Montgomery potential form of pressure force - type(PressureForce_Mont_CS), pointer :: PressureForce_Mont_CSp => NULL() + type(PressureForce_Mont_CS) :: PressureForce_Mont end type PressureForce_CS contains @@ -48,7 +48,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] - type(PressureForce_CS), pointer :: CS !< Pressure force control structure + type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean interface [R L2 T-2 ~> Pa]. @@ -61,18 +61,18 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e if (CS%Analytic_FV_PGF) then if (GV%Boussinesq) then - call PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV_CSp, & + call PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV, & ALE_CSp, p_atm, pbce, eta) else - call PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV_CSp, & + call PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_FV, & ALE_CSp, p_atm, pbce, eta) endif else if (GV%Boussinesq) then - call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont, & p_atm, pbce, eta) else - call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont, & p_atm, pbce, eta) endif endif @@ -87,17 +87,11 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_CS), pointer :: CS !< Pressure force control structure + type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure type(tidal_forcing_CS), intent(inout), optional :: tides_CSp !< Tide control structure #include "version_variable.h" character(len=40) :: mdl = "MOM_PressureForce" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ANALYTIC_FV_PGF", CS%Analytic_FV_PGF, & @@ -109,25 +103,13 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) if (CS%Analytic_FV_PGF) then call PressureForce_FV_init(Time, G, GV, US, param_file, diag, & - CS%PressureForce_FV_CSp, tides_CSp) + CS%PressureForce_FV, tides_CSp) else call PressureForce_Mont_init(Time, G, GV, US, param_file, diag, & - CS%PressureForce_Mont_CSp, tides_CSp) + CS%PressureForce_Mont, tides_CSp) endif - end subroutine PressureForce_init -!> Deallocate the pressure force control structure -subroutine PressureForce_end(CS) - type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure - - if (CS%Analytic_FV_PGF) then - call PressureForce_FV_end(CS%PressureForce_FV_CSp) - else - call PressureForce_Mont_end(CS%PressureForce_Mont_CSp) - endif -end subroutine PressureForce_end - !> \namespace mom_pressureforce !! !! This thin module provides a branch to two forms of the horizontal accelerations diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index ef5a85697c..112730fb59 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -24,7 +24,7 @@ module MOM_PressureForce_FV #include -public PressureForce_FV_init, PressureForce_FV_end +public PressureForce_FV_init public PressureForce_FV_Bouss, PressureForce_FV_nonBouss ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional @@ -84,7 +84,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_FV_CS), intent(in) :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. @@ -163,8 +163,6 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_FV_nonBouss: Module must be initialized before it is used.") if (CS%Stanley_T2_det_coeff>=0.) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: The Stanley parameterization is not yet"//& "implemented in non-Boussinesq mode.") @@ -424,7 +422,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_FV_CS), intent(in) :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. @@ -499,9 +497,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_FV_Bouss: Module must be initialized before it is used.") - use_p_atm = associated(p_atm) use_EOS = associated(tv%eqn_of_state) do i=Isq,Ieq+1 ; p0(i) = 0.0 ; enddo @@ -807,19 +802,13 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_FV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_FV_CS), intent(inout) :: CS !< Finite volume PGF control structure type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. logical :: use_ALE - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ; CS%Time => Time if (present(tides_CSp)) & CS%tides_CSp => tides_CSp @@ -882,13 +871,6 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS end subroutine PressureForce_FV_init -!> Deallocates the finite volume pressure gradient control structure -subroutine PressureForce_FV_end(CS) - type(PressureForce_FV_CS), pointer :: CS !< Finite volume pressure control structure that - !! will be deallocated in this subroutine. - if (associated(CS)) deallocate(CS) -end subroutine PressureForce_FV_end - !> \namespace mom_pressureforce_fv !! !! Provides the Boussinesq and non-Boussinesq forms of horizontal accelerations diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 4b98e0f73f..d77d31484a 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -21,7 +21,7 @@ module MOM_PressureForce_Mont #include public PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss, Set_pbce_Bouss -public Set_pbce_nonBouss, PressureForce_Mont_init, PressureForce_Mont_end +public Set_pbce_nonBouss, PressureForce_Mont_init ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -39,9 +39,9 @@ module MOM_PressureForce_Mont type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. - real, pointer :: PFu_bc(:,:,:) => NULL() !< Zonal accelerations due to pressure gradients + real, allocatable :: PFu_bc(:,:,:) !< Zonal accelerations due to pressure gradients !! deriving from density gradients within layers [L T-2 ~> m s-2]. - real, pointer :: PFv_bc(:,:,:) => NULL() !< Meridional accelerations due to pressure gradients + real, allocatable :: PFv_bc(:,:,:) !< Meridional accelerations due to pressure gradients !! deriving from density gradients within layers [L T-2 ~> m s-2]. !>@{ Diagnostic IDs integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 @@ -70,7 +70,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) [L T-2 ~> m s-2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF + type(PressureForce_Mont_CS), intent(inout) :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -137,8 +137,6 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_Mont: Module must be initialized before it is used.") if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_nonBouss: The Montgomery form of the pressure force "//& @@ -321,14 +319,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ((dp_star(i,j)*dp_star(i+1,j) + (p(i,j,K)*dp_star(i+1,j) + p(i+1,j,K)*dp_star(i,j))) / & (dp_star(i,j) + dp_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc - if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc + if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & ((dp_star(i,j)*dp_star(i,j+1) + (p(i,j,K)*dp_star(i,j+1) + p(i,j+1,K)*dp_star(i,j))) / & (dp_star(i,j) + dp_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc - if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS @@ -366,7 +364,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) [L T-2 ~> m s-2]. - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF + type(PressureForce_Mont_CS), intent(inout) :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in @@ -424,8 +422,6 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, is_split = present(pbce) use_EOS = associated(tv%eqn_of_state) - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_PressureForce_Mont: Module must be initialized before it is used.") if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_Bouss: The Montgomery form of the pressure force "//& @@ -555,14 +551,14 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ((h_star(i,j) * h_star(i+1,j) - (e(i,j,K) * h_star(i+1,j) + & e(i+1,j,K) * h_star(i,j))) / (h_star(i,j) + h_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc - if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc + if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * & ((h_star(i,j) * h_star(i,j+1) - (e(i,j,K) * h_star(i,j+1) + & e(i,j+1,K) * h_star(i,j))) / (h_star(i,j) + h_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc - if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS @@ -824,7 +820,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure + type(PressureForce_Mont_CS), intent(inout) :: CS !< Montgomery PGF control structure type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! Local variables @@ -833,12 +829,6 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ # include "version_variable.h" character(len=40) :: mdl ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "PressureForce_init called with an associated "// & - "control structure.") - return - else ; allocate(CS) ; endif - CS%diag => diag ; CS%Time => Time if (present(tides_CSp)) & CS%tides_CSp => tides_CSp @@ -861,14 +851,10 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ 'Density Gradient Zonal Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) CS%id_PFv_bc = register_diag_field('ocean_model', 'PFv_bc', diag%axesCvL, Time, & 'Density Gradient Meridional Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) - if (CS%id_PFu_bc > 0) then - call safe_alloc_ptr(CS%PFu_bc,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) - CS%PFu_bc(:,:,:) = 0.0 - endif - if (CS%id_PFv_bc > 0) then - call safe_alloc_ptr(CS%PFv_bc,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) - CS%PFv_bc(:,:,:) = 0.0 - endif + if (CS%id_PFu_bc > 0) & + allocate(CS%PFu_bc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.) + if (CS%id_PFv_bc > 0) & + allocate(CS%PFv_bc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.) endif if (CS%tides) then @@ -883,12 +869,6 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ end subroutine PressureForce_Mont_init -!> Deallocates the Montgomery-potential form of PGF control structure -subroutine PressureForce_Mont_end(CS) - type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - if (associated(CS)) deallocate(CS) -end subroutine PressureForce_Mont_end - !>\namespace mom_pressureforce_mont !! !! Provides the Boussunesq and non-Boussinesq forms of the horizontal diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 74e0b8f33d..e4da652181 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -55,7 +55,7 @@ module MOM_dynamics_split_RK2 use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_open_boundary, only : open_boundary_test_extern_h, update_OBC_ramp use MOM_PressureForce, only : PressureForce, PressureForce_CS -use MOM_PressureForce, only : PressureForce_init, PressureForce_end +use MOM_PressureForce, only : PressureForce_init use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_thickness_diffuse, only : thickness_diffuse_CS use MOM_tidal_forcing, only : tidal_forcing_CS @@ -205,7 +205,7 @@ module MOM_dynamics_split_RK2 !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to a structure containing interface height diffusivities type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure @@ -1692,12 +1692,7 @@ subroutine end_dyn_split_RK2(CS) deallocate(CS%vertvisc_CSp) call hor_visc_end(CS%hor_visc) - - call PressureForce_end(CS%PressureForce_CSp) - deallocate(CS%PressureForce_CSp) - call tidal_forcing_end(CS%tides_CSp) - call CoriolisAdv_end(CS%CoriolisAdv) call continuity_end(CS%continuity_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index fb457b1652..536d7dfc52 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -147,7 +147,7 @@ module MOM_dynamics_unsplit !> A pointer to the CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to the vertvisc control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 72614ab3e0..87e3d5e3bf 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -149,7 +149,7 @@ module MOM_dynamics_unsplit_RK2 !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + type(PressureForce_CS) :: PressureForce_CSp !> A pointer to the vertvisc control structure type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() !> A pointer to the set_visc control structure From a250208448482f92dfc2b5dd171898039c4533fc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 15 Nov 2021 15:26:12 -0500 Subject: [PATCH 060/138] MOM continuity CS pointer removal These pointers were defined as locals * `MOM_continuity_CS` * `MOM_continuity_PPM_CS` --- src/core/MOM_continuity.F90 | 34 +++++++-------------------- src/core/MOM_continuity_PPM.F90 | 34 ++++++++------------------- src/core/MOM_dynamics_split_RK2.F90 | 8 ++----- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- 5 files changed, 23 insertions(+), 57 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 655055b03d..2c970e5af1 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -5,7 +5,7 @@ module MOM_continuity use MOM_continuity_PPM, only : continuity_PPM, continuity_PPM_init use MOM_continuity_PPM, only : continuity_PPM_stencil -use MOM_continuity_PPM, only : continuity_PPM_end, continuity_PPM_CS +use MOM_continuity_PPM, only : continuity_PPM_CS use MOM_diag_mediator, only : time_type, diag_ctrl use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -20,7 +20,7 @@ module MOM_continuity #include -public continuity, continuity_init, continuity_end, continuity_stencil +public continuity, continuity_init, continuity_stencil !> Control structure for mom_continuity type, public :: continuity_CS ; private @@ -29,7 +29,7 @@ module MOM_continuity !! - PPM - A directionally split piecewise parabolic reconstruction solver. !! The default, PPM, seems most appropriate for use with our current !! time-splitting strategies. - type(continuity_PPM_CS), pointer :: PPM_CSp => NULL() !< Control structure for mom_continuity_ppm + type(continuity_PPM_CS) :: PPM !< Control structure for mom_continuity_ppm end type continuity_CS integer, parameter :: PPM_SCHEME = 1 !< Enumerated constant to select PPM @@ -59,7 +59,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + type(continuity_CS), intent(in) :: CS !< Control structure for mom_continuity. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume @@ -95,7 +95,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vhbt, " one must be present in call to continuity.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, OBC, uhbt, vhbt, & + call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM, OBC, uhbt, vhbt, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") @@ -111,19 +111,13 @@ subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + type(continuity_CS), intent(inout) :: CS !< Control structure for mom_continuity. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_continuity" ! This module's name. character(len=20) :: tmpstr - if (associated(CS)) then - call MOM_error(WARNING, "continuity_init called with associated control structure.") - return - endif - allocate(CS) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "CONTINUITY_SCHEME", tmpstr, & @@ -145,7 +139,7 @@ subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) end select if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM_CSp) + call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM) endif end subroutine continuity_init @@ -153,24 +147,14 @@ end subroutine continuity_init !> continuity_stencil returns the continuity solver stencil size function continuity_stencil(CS) result(stencil) - type(continuity_CS), pointer :: CS !< Module's control structure. + type(continuity_CS), intent(in) :: CS !< Module's control structure. integer :: stencil !< The continuity solver stencil size with the current settings. stencil = 1 if (CS%continuity_scheme == PPM_SCHEME) then - stencil = continuity_PPM_stencil(CS%PPM_CSp) + stencil = continuity_PPM_stencil(CS%PPM) endif - end function continuity_stencil -!> Destructor for continuity_cs. -subroutine continuity_end(CS) - type(continuity_CS), intent(inout) :: CS !< Control structure for mom_continuity. - - if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_end(CS%PPM_CSp) - endif -end subroutine continuity_end - end module MOM_continuity diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a9cd01a6df..cc56654d30 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -18,7 +18,7 @@ module MOM_continuity_PPM #include -public continuity_PPM, continuity_PPM_init, continuity_PPM_end, continuity_PPM_stencil +public continuity_PPM, continuity_PPM_init, continuity_PPM_stencil !>@{ CPU time clock IDs integer :: id_clock_update, id_clock_correct @@ -91,7 +91,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< Module's control structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces @@ -134,8 +134,6 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh h_min = GV%Angstrom_H - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_continuity_PPM: Module must be initialized before it is used.") x_first = (MOD(G%first_direction,2) == 0) if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & @@ -220,7 +218,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, uhbt, & !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G)), & @@ -736,7 +734,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! The barotropic velocity adjustment [L T-1 ~> m s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -878,7 +876,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! value of du [L T-1 ~> m s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer @@ -1029,7 +1027,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, vhbt, & !! faces = v*h*dx [H L2 s-1 ~> m3 s-1 or kg s-1] real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure.G type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. @@ -1545,7 +1543,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1688,7 +1686,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! of dv [L T-1 ~> m s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -2198,18 +2196,12 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) !! the open file to parse for model parameter values. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to !! regulate diagnostic output. - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(continuity_PPM_CS), intent(inout) :: CS !< Module's control structure. !> This include declares and sets the variable "version". #include "version_variable.h" real :: tol_eta_m ! An unscaled version of tol_eta [m]. character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. - if (associated(CS)) then - call MOM_error(WARNING, "continuity_PPM_init called with associated control structure.") - return - endif - allocate(CS) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MONOTONIC_CONTINUITY", CS%monotonic, & @@ -2286,19 +2278,13 @@ end subroutine continuity_PPM_init !> continuity_PPM_stencil returns the continuity solver stencil size function continuity_PPM_stencil(CS) result(stencil) - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< Module's control structure. integer :: stencil !< The continuity solver stencil size with the current settings. stencil = 3 ; if (CS%simple_2nd) stencil = 2 ; if (CS%upwind_1st) stencil = 1 end function continuity_PPM_stencil -!> Destructor for continuity_ppm_cs -subroutine continuity_PPM_end(CS) - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. - deallocate(CS) -end subroutine continuity_PPM_end - !> \namespace mom_continuity_ppm !! !! This module contains the subroutines that advect layer diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index e4da652181..0459b8123c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -39,8 +39,7 @@ module MOM_dynamics_split_RK2 use MOM_barotropic, only : barotropic_end use MOM_boundary_update, only : update_OBC_data, update_OBC_CS use MOM_continuity, only : continuity, continuity_CS -use MOM_continuity, only : continuity_init, continuity_end -use MOM_continuity, only : continuity_stencil +use MOM_continuity, only : continuity_init, continuity_stencil use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_CS use MOM_CoriolisAdv, only : CoriolisAdv_init, CoriolisAdv_end use MOM_debugging, only : check_redundant @@ -201,7 +200,7 @@ module MOM_dynamics_split_RK2 !> A pointer to the horizontal viscosity control structure type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() + type(continuity_CS) :: continuity_CSp !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure @@ -1695,9 +1694,6 @@ subroutine end_dyn_split_RK2(CS) call tidal_forcing_end(CS%tides_CSp) call CoriolisAdv_end(CS%CoriolisAdv) - call continuity_end(CS%continuity_CSp) - deallocate(CS%continuity_CSp) - DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 536d7dfc52..d1a5de002b 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -143,7 +143,7 @@ module MOM_dynamics_unsplit !> A pointer to the horizontal viscosity control structure type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() + type(continuity_CS) :: continuity_CSp !> A pointer to the CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 87e3d5e3bf..a609ac8683 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -145,7 +145,7 @@ module MOM_dynamics_unsplit_RK2 !> A pointer to the horizontal viscosity control structure type(hor_visc_CS) :: hor_visc !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() + type(continuity_CS) :: continuity_CSp !> The CoriolisAdv control structure type(CoriolisAdv_CS) :: CoriolisAdv !> A pointer to the PressureForce control structure From d00c90b60eb7ef8d572ea3361730f2cbdff3e0dc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 16 Nov 2021 09:50:10 -0500 Subject: [PATCH 061/138] MOM_open_boundary pointer removal This patch replaces many pointers in the OBC with local or allocatable variables. Notes: * `OBC` redeclared as `target` in some places for `segment` pointers * `field_names` removed from `OBC_segment_type` * `Tr_Reg` removed from `set_tracer_data` * `OBC` removed from `deallocate_OBC_segment_data` --- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_open_boundary.F90 | 358 ++++++++---------- .../MOM_state_initialization.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 12 +- src/user/DOME_initialization.F90 | 2 +- src/user/Kelvin_initialization.F90 | 4 +- 6 files changed, 179 insertions(+), 201 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index f49ce0073b..32eb036a94 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3039,7 +3039,7 @@ end subroutine apply_velocity_OBCs !! boundary conditions, as developed by Mehmet Ilicak. subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, & integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v) - type(ocean_OBC_type), intent(inout) :: OBC !< An associated pointer to an OBC type. + type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ed885b9574..581cd5e68e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -75,26 +75,26 @@ module MOM_open_boundary !> Open boundary segment data from files (mostly). type, public :: OBC_segment_data_type - integer :: fid !< handle from FMS associated with segment data on disk - integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk - character(len=8) :: name !< a name identifier for the segment data - real, dimension(:,:,:), allocatable :: buffer_src !< buffer for segment data located at cell faces - !! and on the original vertical grid - integer :: nk_src !< Number of vertical levels in the source data - real, dimension(:,:,:), allocatable :: dz_src !< vertical grid cell spacing of the incoming segment - !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] - real, dimension(:,:,:), pointer :: buffer_dst=>NULL() !< buffer src data remapped to the target vertical grid + integer :: fid !< handle from FMS associated with segment data on disk + integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk + character(len=8) :: name !< a name identifier for the segment data + real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces + !! and on the original vertical grid + integer :: nk_src !< Number of vertical levels in the source data + real, allocatable :: dz_src(:,:,:) !< vertical grid cell spacing of the incoming segment + !! data, set in [Z ~> m] then scaled to [H ~> m or kg m-2] + real, allocatable :: buffer_dst(:,:,:) !< buffer src data remapped to the target vertical grid real :: value !< constant value if fid is equal to -1 end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. type, public :: OBC_segment_tracer_type - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array - real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows - character(len=32) :: name !< tracer name used for error messages - type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer - real, dimension(:,:,:), pointer :: tres => NULL() !< tracer reservoir array - logical :: is_initialized !< reservoir values have been set when True + real, allocatable :: t(:,:,:) !< tracer concentration array + real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows + character(len=32) :: name !< tracer name used for error messages + type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer + real, allocatable :: tres(:,:,:) !< tracer reservoir array + logical :: is_initialized !< reservoir values have been set when True end type OBC_segment_tracer_type !> Registry type for tracers on segments @@ -145,9 +145,8 @@ module MOM_open_boundary logical :: is_N_or_S !< True if the OB is facing North or South and exists on this PE. logical :: is_E_or_W !< True if the OB is facing East or West and exists on this PE. logical :: is_E_or_W_2 !< True if the OB is facing East or West anywhere. - type(OBC_segment_data_type), pointer, dimension(:) :: field=>NULL() !< OBC data + type(OBC_segment_data_type), pointer :: field(:) => NULL() !< OBC data integer :: num_fields !< number of OBC data fields (e.g. u_normal,u_parallel and eta for Flather) - character(len=32), pointer, dimension(:) :: field_names=>NULL() !< field names for this segment integer :: Is_obc !< i-indices of boundary segment. integer :: Ie_obc !< i-indices of boundary segment. integer :: Js_obc !< j-indices of boundary segment. @@ -163,44 +162,44 @@ module MOM_open_boundary logical :: on_pe !< true if any portion of the segment is located in this PE's data domain logical :: temp_segment_data_exists !< true if temperature data arrays are present logical :: salt_segment_data_exists !< true if salinity data arrays are present - real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [L T-1 ~> m s-1] - !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [H ~> m or kg m-2] at OBC-points. - real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment [T-1 ~> s-1]. - real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [H L2 T-1 ~> m3 s-1]. - real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [L T-1 ~> m s-1]. - real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the - !! segment [H ~> m or kg m-2]. - real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along - !! the segment times the grid spacing [T-1 ~> s-1] - real, pointer, dimension(:,:,:) :: rx_norm_rad=>NULL() !< The previous normal phase speed use for EW radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: ry_norm_rad=>NULL() !< The previous normal phase speed use for NS radiation - !! OBC, in grid points per timestep [nondim] - real, pointer, dimension(:,:,:) :: rx_norm_obl=>NULL() !< The previous normal radiation coefficient for EW - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: ry_norm_obl=>NULL() !< The previous normal radiation coefficient for NS - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation - !! for normal velocity [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. - real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur [T-1 ~> s-1]. + real, allocatable :: Cg(:,:) !< The external gravity wave speed [L T-1 ~> m s-1] + !! at OBC-points. + real, allocatable :: Htot(:,:) !< The total column thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: h(:,:,:) !< The cell thickness [H ~> m or kg m-2] at OBC-points. + real, allocatable :: normal_vel(:,:,:) !< The layer velocity normal to the OB + !! segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_vel(:,:,:) !< The layer velocity tangential to the + !! OB segment [L T-1 ~> m s-1]. + real, allocatable :: tangential_grad(:,:,:) !< The gradient of the velocity tangential + !! to the OB segment [T-1 ~> s-1]. + real, allocatable :: normal_trans(:,:,:) !< The layer transport normal to the OB + !! segment [H L2 T-1 ~> m3 s-1]. + real, allocatable :: normal_vel_bt(:,:) !< The barotropic velocity normal to + !! the OB segment [L T-1 ~> m s-1]. + real, allocatable :: eta(:,:) !< The sea-surface elevation along the + !! segment [H ~> m or kg m-2]. + real, allocatable :: grad_normal(:,:,:) !< The gradient of the normal flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_tan(:,:,:) !< The gradient of the tangential flow along the + !! segment times the grid spacing [L T-1 ~> m s-1] + real, allocatable :: grad_gradient(:,:,:) !< The gradient of the gradient of tangential flow along + !! the segment times the grid spacing [T-1 ~> s-1] + real, allocatable :: rx_norm_rad(:,:,:) !< The previous normal phase speed use for EW radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: ry_norm_rad(:,:,:) !< The previous normal phase speed use for NS radiation + !! OBC, in grid points per timestep [nondim] + real, allocatable :: rx_norm_obl(:,:,:) !< The previous normal radiation coefficient for EW + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_norm_obl(:,:,:) !< The previous normal radiation coefficient for NS + !! oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< The denominator for oblique radiation + !! for normal velocity [L2 T-2 ~> m2 s-2] + real, allocatable :: nudged_normal_vel(:,:,:) !< The layer velocity normal to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_vel(:,:,:) !< The layer velocity tangential to the OB segment + !! that values should be nudged towards [L T-1 ~> m s-1]. + real, allocatable :: nudged_tangential_grad(:,:,:) !< The layer dvdx or dudy towards which nudging + !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale_out !< An effective inverse length scale for restoring @@ -256,11 +255,9 @@ module MOM_open_boundary logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. logical :: brushcutter_mode = .false. !< If True, read data on supergrid. - logical, pointer, dimension(:) :: & - tracer_x_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_x_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with x reservoirs (needed for restarts). - logical, pointer, dimension(:) :: & - tracer_y_reservoirs_used => NULL() !< Dimensioned by the number of tracers, set globally, + logical, allocatable :: tracer_y_reservoirs_used(:) !< Dimensioned by the number of tracers, set globally, !! true for those with y reservoirs (needed for restarts). integer :: ntr = 0 !< number of tracers integer :: n_tide_constituents = 0 !< Number of tidal constituents to add to the boundary. @@ -278,12 +275,10 @@ module MOM_open_boundary type(time_type) :: time_ref !< Reference date (t = 0) for tidal forcing. type(astro_longitudes) :: tidal_longitudes !< Lunar and solar longitudes used to calculate tidal forcing. ! Properties of the segments used. - type(OBC_segment_type), pointer, dimension(:) :: & - segment => NULL() !< List of segment objects. + type(OBC_segment_type), allocatable :: segment(:) !< List of segment objects. ! Which segment object describes the current point. - integer, pointer, dimension(:,:) :: & - segnum_u => NULL(), & !< Segment number of u-points. - segnum_v => NULL() !< Segment number of v-points. + integer, allocatable :: segnum_u(:,:) !< Segment number of u-points. + integer, allocatable :: segnum_v(:,:) !< Segment number of v-points. ! The following parameters are used in the baroclinic radiation code: real :: gamma_uv !< The relative weighting for the baroclinic radiation @@ -295,17 +290,15 @@ module MOM_open_boundary logical :: OBC_pe !< Is there an open boundary on this tile? type(remapping_CS), pointer :: remap_CS=> NULL() !< ALE remapping control structure for segments only type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries - real, pointer, dimension(:,:,:) :: & - rx_normal => NULL(), & !< Array storage for normal phase speed for EW radiation OBCs in units of - !! grid points per timestep [nondim] - ry_normal => NULL(), & !< Array storage for normal phase speed for NS radiation OBCs in units of - !! grid points per timestep [nondim] - rx_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - ry_oblique => NULL(), & !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - cff_normal => NULL() !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - real, pointer, dimension(:,:,:,:) :: & - tres_x => NULL(), & !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] - tres_y => NULL() !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: rx_normal(:,:,:) !< Array storage for normal phase speed for EW radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of + !! grid points per timestep [nondim] + real, allocatable :: rx_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] + real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts [conc L ~> conc m] real :: silly_h !< A silly value of thickness outside of the domain that can be used to test !! the independence of the OBCs to this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that can be used to test @@ -651,9 +644,9 @@ end subroutine open_boundary_config !> Allocate space for reading OBC data from files. It sets up the required vertical !! remapping. In the process, it does funky stuff with the MPI processes. subroutine initialize_segment_data(G, OBC, PF) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: PF !< Parameter file handle integer :: n, m, num_fields character(len=1024) :: segstr @@ -688,7 +681,6 @@ subroutine initialize_segment_data(G, OBC, PF) ! Try this here just for the documentation. It is repeated below. do n=1, OBC%number_of_segments - segment => OBC%segment(n) write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n call get_param(PF, mdl, segnam, segstr, 'OBC segment docs') enddo @@ -958,14 +950,14 @@ subroutine initialize_segment_data(G, OBC, PF) end subroutine initialize_segment_data subroutine initialize_obc_tides(OBC, param_file) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing (year, month, day). integer, dimension(3) :: nodal_ref_date !< Date to calculate nodal modulation for (year, month, day). character(len=50) :: tide_constituent_str !< List of tidal constituents to include on boundary. - type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing - type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. - integer :: c !< Index to tidal constituent. + type(astro_longitudes) :: nodal_longitudes !< Solar and lunar longitudes for tidal forcing + type(time_type) :: nodal_time !< Model time to calculate nodal modulation for. + integer :: c !< Index to tidal constituent. call get_param(param_file, mdl, "OBC_TIDE_CONSTITUENTS", tide_constituent_str, & "Names of tidal constituents being added to the open boundaries.", & @@ -1175,7 +1167,7 @@ end subroutine setup_segment_indices !> Parse an OBC_SEGMENT_%%% string starting with "I=" and configure placement and type of OBC accordingly subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string" @@ -1315,7 +1307,7 @@ end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string" @@ -1638,8 +1630,8 @@ end subroutine parse_segment_data_str !> Parse all the OBC_SEGMENT_%%%_DATA strings again !! to see which need tracer reservoirs (all pes need to know). subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) - type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure - type(param_file_type), intent(in) :: PF !< Parameter file handle + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(param_file_type), intent(in) :: PF !< Parameter file handle logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables @@ -1809,16 +1801,16 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) To_All+Scalar_Pair) if (OBC%oblique_BCs_exist_globally) call pass_vector(OBC%rx_oblique, OBC%ry_oblique, G%Domain, & To_All+Scalar_Pair) - if (associated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) - if (associated(OBC%tres_x) .and. associated(OBC%tres_y)) then + if (allocated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) + if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_vector(OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%Domain, To_All+Scalar_Pair) enddo - elseif (associated(OBC%tres_x)) then + elseif (allocated(OBC%tres_x)) then do m=1,OBC%ntr call pass_var(OBC%tres_x(:,:,:,m), G%Domain, position=EAST_FACE) enddo - elseif (associated(OBC%tres_y)) then + elseif (allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_var(OBC%tres_y(:,:,:,m), G%Domain, position=NORTH_FACE) enddo @@ -1897,18 +1889,18 @@ subroutine open_boundary_dealloc(OBC) do n=1, OBC%number_of_segments segment => OBC%segment(n) - call deallocate_OBC_segment_data(OBC, segment) + call deallocate_OBC_segment_data(segment) enddo - if (associated(OBC%segment)) deallocate(OBC%segment) - if (associated(OBC%segnum_u)) deallocate(OBC%segnum_u) - if (associated(OBC%segnum_v)) deallocate(OBC%segnum_v) - if (associated(OBC%rx_normal)) deallocate(OBC%rx_normal) - if (associated(OBC%ry_normal)) deallocate(OBC%ry_normal) - if (associated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) - if (associated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) - if (associated(OBC%cff_normal)) deallocate(OBC%cff_normal) - if (associated(OBC%tres_x)) deallocate(OBC%tres_x) - if (associated(OBC%tres_y)) deallocate(OBC%tres_y) + if (allocated(OBC%segment)) deallocate(OBC%segment) + if (allocated(OBC%segnum_u)) deallocate(OBC%segnum_u) + if (allocated(OBC%segnum_v)) deallocate(OBC%segnum_v) + if (allocated(OBC%rx_normal)) deallocate(OBC%rx_normal) + if (allocated(OBC%ry_normal)) deallocate(OBC%ry_normal) + if (allocated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) + if (allocated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) + if (allocated(OBC%cff_normal)) deallocate(OBC%cff_normal) + if (allocated(OBC%tres_x)) deallocate(OBC%tres_x) + if (allocated(OBC%tres_y)) deallocate(OBC%tres_y) deallocate(OBC) end subroutine open_boundary_dealloc @@ -2077,8 +2069,8 @@ end subroutine open_boundary_impose_land_mask subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - ! Local variables + type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure + type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, m, n @@ -2088,7 +2080,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%t(i,j,k) @@ -2099,7 +2091,7 @@ subroutine setup_OBC_tracer_reservoirs(G, GV, OBC) else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%t(i,J,k) @@ -2209,7 +2201,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (segment%is_E_or_W) then I = segment%HI%IsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do j=segment%HI%jsd,segment%HI%jed segment%tr_Reg%Tr(m)%tres(I,j,k) = OBC%tres_x(I,j,k,m) @@ -2220,7 +2212,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, else J = segment%HI%JsdB do m=1,OBC%ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then do k=1,GV%ke do i=segment%HI%isd,segment%HI%ied segment%tr_Reg%Tr(m)%tres(i,J,k) = OBC%tres_y(i,J,k,m) @@ -3298,7 +3290,7 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, GV, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(OBC_segment_type), pointer :: segment !< OBC segment structure + type(OBC_segment_type), intent(inout) :: segment !< OBC segment structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k @@ -3420,15 +3412,14 @@ end subroutine gradient_at_q_points !> Sets the initial values of the tracer open boundary conditions. !! Redoing this elsewhere. -subroutine set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure +subroutine set_tracer_data(OBC, tv, h, G, GV, PF) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness - type(param_file_type), intent(in) :: PF !< Parameter file handle - type(tracer_registry_type), pointer :: tracer_Reg !< Tracer registry - ! Local variables + type(ocean_OBC_type), target, intent(in) :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness + type(param_file_type), intent(in) :: PF !< Parameter file handle + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz, n integer :: isd_off, jsd_off integer :: IsdB, IedB, JsdB, JedB @@ -3484,7 +3475,7 @@ end subroutine set_tracer_data !> Needs documentation function lookup_seg_field(OBC_seg,field) - type(OBC_segment_type), pointer :: OBC_seg !< OBC segment + type(OBC_segment_type), intent(in) :: OBC_seg !< OBC segment character(len=32), intent(in) :: field !< The field name integer :: lookup_seg_field ! Local variables @@ -3503,7 +3494,7 @@ end function lookup_seg_field !> Allocate segment data fields subroutine allocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(ocean_OBC_type), intent(in) :: OBC !< Open boundary structure type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables integer :: isd, ied, jsd, jed @@ -3593,35 +3584,35 @@ subroutine allocate_OBC_segment_data(OBC, segment) end subroutine allocate_OBC_segment_data !> Deallocate segment data fields -subroutine deallocate_OBC_segment_data(OBC, segment) - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure +subroutine deallocate_OBC_segment_data(segment) type(OBC_segment_type), intent(inout) :: segment !< Open boundary segment ! Local variables character(len=40) :: mdl = "deallocate_OBC_segment_data" ! This subroutine's name. if (.not. segment%on_pe) return - if (associated (segment%Cg)) deallocate(segment%Cg) - if (associated (segment%Htot)) deallocate(segment%Htot) - if (associated (segment%h)) deallocate(segment%h) - if (associated (segment%eta)) deallocate(segment%eta) - if (associated (segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) - if (associated (segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) - if (associated (segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) - if (associated (segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) - if (associated (segment%cff_normal)) deallocate(segment%cff_normal) - if (associated (segment%grad_normal)) deallocate(segment%grad_normal) - if (associated (segment%grad_tan)) deallocate(segment%grad_tan) - if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient) - if (associated (segment%normal_vel)) deallocate(segment%normal_vel) - if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) - if (associated (segment%normal_trans)) deallocate(segment%normal_trans) - if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) - if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) - if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) - if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) - if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) - if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) + if (allocated(segment%Cg)) deallocate(segment%Cg) + if (allocated(segment%Htot)) deallocate(segment%Htot) + if (allocated(segment%h)) deallocate(segment%h) + if (allocated(segment%eta)) deallocate(segment%eta) + if (allocated(segment%rx_norm_rad)) deallocate(segment%rx_norm_rad) + if (allocated(segment%ry_norm_rad)) deallocate(segment%ry_norm_rad) + if (allocated(segment%rx_norm_obl)) deallocate(segment%rx_norm_obl) + if (allocated(segment%ry_norm_obl)) deallocate(segment%ry_norm_obl) + if (allocated(segment%cff_normal)) deallocate(segment%cff_normal) + if (allocated(segment%grad_normal)) deallocate(segment%grad_normal) + if (allocated(segment%grad_tan)) deallocate(segment%grad_tan) + if (allocated(segment%grad_gradient)) deallocate(segment%grad_gradient) + if (allocated(segment%normal_vel)) deallocate(segment%normal_vel) + if (allocated(segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) + if (allocated(segment%normal_trans)) deallocate(segment%normal_trans) + if (allocated(segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) + if (allocated(segment%tangential_vel)) deallocate(segment%tangential_vel) + if (allocated(segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (allocated(segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) + if (allocated(segment%tangential_grad)) deallocate(segment%tangential_grad) + + if (associated(segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) end subroutine deallocate_OBC_segment_data @@ -3738,14 +3729,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) integer :: i2, j2 ! indices for referencing local domain array integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain integer :: ishift, jshift ! offsets for staggered locations - real, dimension(:,:), pointer :: seg_vel => NULL() ! pointer to segment velocity array - real, dimension(:,:), pointer :: seg_trans => NULL() ! pointer to segment transport array real, dimension(:,:,:), allocatable, target :: tmp_buffer real, dimension(:), allocatable :: h_stack integer :: is_obc2, js_obc2 real :: net_H_src, net_H_int, scl_fac real :: tidal_vel, tidal_elev - real, pointer, dimension(:,:) :: normal_trans_bt=>NULL() ! barotropic transport + real, allocatable :: normal_trans_bt(:,:) ! barotropic transport integer :: turns ! Number of index quarter turns real :: time_delta ! Time since tidal reference date @@ -3816,7 +3805,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) siz(1)=size(segment%field(m)%buffer_src,1) siz(2)=size(segment%field(m)%buffer_src,2) siz(3)=size(segment%field(m)%buffer_src,3) - if (.not.associated(segment%field(m)%buffer_dst)) then + if (.not.allocated(segment%field(m)%buffer_dst)) then if (siz(3) /= segment%field(m)%nk_src) call MOM_error(FATAL,'nk_src inconsistency') if (segment%field(m)%nk_src > 1) then if (segment%is_E_or_W) then @@ -4113,7 +4102,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (turns /= 0) & deallocate(tmp_buffer_in) else ! fid <= 0 (Uniform value) - if (.not. associated(segment%field(m)%buffer_dst)) then + if (.not. allocated(segment%field(m)%buffer_dst)) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,GV%ke)) @@ -4178,7 +4167,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) & / (max(segment%Htot(I,j), 1.e-12 * GV%m_to_H) * G%dyCu(I,j)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then J=js_obc @@ -4200,10 +4189,10 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) & / (max(segment%Htot(i,J), 1.e-12 * GV%m_to_H) * G%dxCv(i,J)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) + if (allocated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then I=is_obc do J=js_obc,je_obc tidal_vel = 0.0 @@ -4217,11 +4206,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. & - associated(segment%tangential_vel)) then + allocated(segment%tangential_vel)) then J=js_obc do I=is_obc,ie_obc tidal_vel = 0.0 @@ -4235,27 +4224,27 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,GV%ke segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(segment%field(m)%buffer_dst(I,J,k) + tidal_vel) enddo - if (associated(segment%nudged_tangential_vel)) & + if (allocated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo endif elseif (trim(segment%field(m)%name) == 'DVDX' .and. segment%is_E_or_W .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then I=is_obc do J=js_obc,je_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & - associated(segment%tangential_grad)) then + allocated(segment%tangential_grad)) then J=js_obc do I=is_obc,ie_obc do k=1,GV%ke segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) - if (associated(segment%nudged_tangential_grad)) & + if (allocated(segment%nudged_tangential_grad)) & segment%nudged_tangential_grad(I,J,:) = segment%tangential_grad(I,J,:) enddo enddo @@ -4314,7 +4303,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif if (trim(segment%field(m)%name) == 'TEMP') then - if (associated(segment%field(m)%buffer_dst)) then + if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4329,7 +4318,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%tr_Reg%Tr(1)%OBC_inflow_conc = segment%field(m)%value endif elseif (trim(segment%field(m)%name) == 'SALT') then - if (associated(segment%field(m)%buffer_dst)) then + if (allocated(segment%field(m)%buffer_dst)) then do k=1,nz ; do j=js_obc2,je_obc ; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo @@ -4358,7 +4347,7 @@ end subroutine update_OBC_segment_data !! value of Time as the beginning of the ramp period. subroutine update_OBC_ramp(Time, OBC, activate) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary structure logical, optional, intent(in) :: activate !< Specifiy whether to record the value of !! Time as the beginning of the ramp period @@ -4582,7 +4571,7 @@ subroutine segment_tracer_registry_end(Reg) if (associated(Reg)) then do n = 1, Reg%ntseg - if (associated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) + if (allocated(Reg%Tr(n)%t)) deallocate(Reg%Tr(n)%t) enddo deallocate(Reg) endif @@ -4623,12 +4612,11 @@ subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) end subroutine register_temp_salt_segments subroutine fill_temp_salt_segments(G, GV, OBC, tv) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure -! Local variables integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n, nz integer :: i, j, k type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -4946,15 +4934,6 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart call MOM_error(FATAL, "open_boundary_register_restarts: Called with "//& "uninitialized OBC control structure") - if (associated(OBC%rx_normal) .or. associated(OBC%ry_normal) .or. & - associated(OBC%rx_oblique) .or. associated(OBC%ry_oblique) .or. associated(OBC%cff_normal)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - - if (associated(OBC%tres_x) .or. associated(OBC%tres_y)) & - call MOM_error(FATAL, "open_boundary_register_restarts: Restart "//& - "arrays were previously allocated") - ! *** This is a temporary work around for restarts with OBC segments. ! This implementation uses 3D arrays solely for restarts. We need ! to be able to add 2D ( x,z or y,z ) data to restarts to avoid using @@ -4984,7 +4963,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart endif if (Reg%ntr == 0) return - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then OBC%ntr = Reg%ntr allocate(OBC%tracer_x_reservoirs_used(Reg%ntr), source=.false.) allocate(OBC%tracer_y_reservoirs_used(Reg%ntr), source=.false.) @@ -5046,7 +5025,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, intent(in) :: dt !< time increment [T ~> s] type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - ! Local variables + type(OBC_segment_type), pointer :: segment=>NULL() real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell [L ~> m] real :: v_L_in, v_L_out ! The meridional distance moved in or out of a cell [L ~> m] @@ -5072,7 +5051,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(I+ishift,j) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & @@ -5081,7 +5060,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) - if (associated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) + if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) enddo ; endif ; enddo enddo elseif (segment%is_N_or_S) then @@ -5097,7 +5076,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! Can keep this or take it out, either way if (G%mask2dT(i,j+jshift) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep - do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & @@ -5106,7 +5085,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & v_L_in*segment%tr_Reg%Tr(m)%t(i,J,k))) - if (associated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) + if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = segment%tr_Reg%Tr(m)%tres(i,J,k) enddo ; endif ; enddo enddo endif @@ -5123,12 +5102,12 @@ end subroutine update_segment_tracer_reservoirs !! @remark{There is a (hard-wired) "tolerance" parameter such that the !! criteria for adjustment must equal or exceed 10cm.} subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(OBC_segment_type), intent(inout) :: segment !< pointer to segment type - integer, intent(in) :: fld !< field index to adjust thickness - ! Local variables + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(OBC_segment_type), intent(inout) :: segment !< OBC segment + integer, intent(in) :: fld !< field index to adjust thickness + integer :: i, j, k, is, ie, js, je, nz, contractions, dilations integer :: n real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] @@ -5434,7 +5413,7 @@ end subroutine rotate_OBC_segment_config !> Initialize the segments and field-related data of a rotated OBC. subroutine rotate_OBC_init(OBC_in, G, GV, US, param_file, tv, restart_CS, OBC) - type(ocean_OBC_type), pointer, intent(in) :: OBC_in !< OBC on input map + type(ocean_OBC_type), intent(in) :: OBC_in !< OBC on input map type(ocean_grid_type), intent(in) :: G !< Rotated grid metric type(verticalGrid_type), intent(in) :: GV !< Vertical grid type(unit_scale_type), intent(in) :: US !< Unit scaling @@ -5523,7 +5502,6 @@ subroutine rotate_OBC_segment_data(segment_in, segment, turns) segment%field(n)%dz_src) endif - segment%field(n)%buffer_dst => NULL() segment%field(n)%value = segment_in%field(n)%value enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 37acb8ca42..dfcd097be0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -630,7 +630,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "OBC_USER_CONFIG = "//trim(config)//" have not been fully implemented.") endif if (open_boundary_query(OBC, apply_open_OBC=.true.)) then - call set_tracer_data(OBC, tv, h, G, GV, PF, tracer_Reg) + call set_tracer_data(OBC, tv, h, G, GV, PF) endif endif ! if (open_boundary_query(OBC, apply_nudged_OBC=.true.)) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index be4c059982..34c8dddf04 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -450,7 +450,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then I = segment%HI%IsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_W) then T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -594,7 +594,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = uhr(I,j,k) ! should the reservoir evolve for this case Kate ?? - Nope do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else ; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -617,7 +617,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then uhh(I) = uhr(I,j,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) else; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif enddo @@ -821,7 +821,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (i>=segment%HI%isd .and. i<=segment%HI%ied) then J = segment%HI%JsdB do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_S) then T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) else @@ -966,7 +966,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo @@ -989,7 +989,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then + if (allocated(segment%tr_Reg%Tr(m)%t)) then flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 8599272e32..ee4491799a 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -256,7 +256,7 @@ subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) ! Store this information for use in setting up the OBC restarts for tracer reservoirs. OBC%ntr = tr_Reg%ntr - if (.not. associated(OBC%tracer_x_reservoirs_used)) then + if (.not. allocated(OBC%tracer_x_reservoirs_used)) then allocate(OBC%tracer_x_reservoirs_used(OBC%ntr)) allocate(OBC%tracer_y_reservoirs_used(OBC%ntr)) OBC%tracer_x_reservoirs_used(:) = .false. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index fe5168ab7e..9bdf9b45c3 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -287,7 +287,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB+1,JedB-1 ; do I=IsdB,IedB x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J) @@ -343,7 +343,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif endif enddo ; enddo - if (associated(segment%tangential_vel)) then + if (allocated(segment%tangential_vel)) then do J=JsdB,JedB ; do I=IsdB+1,IedB-1 x1 = km_to_L_scale * G%geoLonBu(I,J) y1 = km_to_L_scale * G%geoLatBu(I,J) From bc826090c38f372e459f7b35d122baf81cd16218 Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Fri, 19 Nov 2021 14:57:00 -0500 Subject: [PATCH 062/138] small fixes to porous topo code * Style Fixes * Store depths for porous curve fitting as [Z ~> m] and account for Z_ref --- src/core/MOM_dynamics_split_RK2.F90 | 3 +- src/core/MOM_dynamics_unsplit.F90 | 3 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 3 +- src/core/MOM_grid.F90 | 12 +- src/core/MOM_porous_barriers.F90 | 138 +++++++++--------- src/core/MOM_transcribe_grid.F90 | 24 +-- src/framework/MOM_dyn_horgrid.F90 | 12 +- .../MOM_shared_initialization.F90 | 22 +-- 8 files changed, 114 insertions(+), 103 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index fa796c7fe8..e3f30417ef 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -398,7 +398,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo enddo - ueffA(:,:,:) = 0; veffA(:,:,:) = 0 + if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 + if (CS%id_veffA > 0) veffA(:,:,:) = 0 ! Update CFL truncation value as function of time call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 7cfc9d649c..e52085c2d5 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -244,7 +244,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 - ueffA(:,:,:) = 0; veffA(:,:,:) = 0 + if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 + if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index a7d9abc856..f8112fe4cd 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -254,7 +254,8 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 - ueffA(:,:,:) = 0; veffA(:,:,:) = 0 + if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 + if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 90482c6754..b7ef04b76f 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -113,14 +113,14 @@ module MOM_grid areaCv !< The areas of the v-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - porous_DminU, & !< minimum topographic height of U-face [m] - porous_DmaxU, & !< maximum topographic height of U-face [m] - porous_DavgU !< average topographic height of U-face [m] + porous_DminU, & !< minimum topographic height of U-face [Z ~> m] + porous_DmaxU, & !< maximum topographic height of U-face [Z ~> m] + porous_DavgU !< average topographic height of U-face [Z ~> m] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - porous_DminV, & !< minimum topographic height of V-face [m] - porous_DmaxV, & !< maximum topographic height of V-face [m] - porous_DavgV !< average topographic height of V-face [m] + porous_DminV, & !< minimum topographic height of V-face [Z ~> m] + porous_DmaxV, & !< maximum topographic height of V-face [Z ~> m] + porous_DavgV !< average topographic height of V-face [Z ~> m] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index 4220f2c462..1230b47cfb 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -1,4 +1,4 @@ -!> Function for calculating curve fit for porous topography. +!> Module for calculating curve fit for porous topography. !written by sjd module MOM_porous_barriers @@ -24,6 +24,7 @@ module MOM_porous_barriers contains +!> subroutine to assign cell face areas and layer widths for porous topography subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) !eta_bt, halo_size, eta_to_m not currently used !variables needed to call find_eta @@ -57,69 +58,74 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) IsdB = G%IsdB; IedB = G%IedB; JsdB = G%JsdB; JedB = G%JedB !eta is zero at surface and decreases downward - !all calculations are done in [m] nk = SZK_(G) !currently no treatment for using optional find_eta arguments if present call find_eta(h, tv, G, GV, US, eta) - do I=IsdB,IedB; do j=jsd,jed - if (G%porous_DavgU(I,j) < 0.) then - do K = nk+1,1,-1 - eta_s = max(US%Z_to_m*eta(I,j,K), US%Z_to_m*eta(I+1,j,K)) !take shallower layer height - !eta_s = 0.5 * (US%Z_to_m*eta(I,j,K) + US%Z_to_m*eta(I+1,j,K)) !take arithmetic mean - if (eta_s <= G%porous_DminU(I,j)) then - pbv%por_layer_widthU(I,j,K) = 0.0 - A_layer_prev = 0.0 - if (K < nk+1) then - pbv%por_face_areaU(I,j,k) = 0.0; endif - else - call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j),& - eta_s, w_layer, A_layer) - pbv%por_layer_widthU(I,j,K) = w_layer - if (k <= nk) then - if ((eta_s - eta_prev) > 0.0) then - pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev)/& + do j=jsd,jed; do I=IsdB,IedB + if (G%porous_DavgU(I,j) < 0.) then + do K = nk+1,1,-1 + eta_s = max(US%Z_to_m*eta(I,j,K), US%Z_to_m*eta(I+1,j,K)) !take shallower layer height + !eta_s = 0.5 * (US%Z_to_m*eta(I,j,K) + US%Z_to_m*eta(I+1,j,K)) !take arithmetic mean + if (eta_s <= G%porous_DminU(I,j)) then + pbv%por_layer_widthU(I,j,K) = 0.0 + A_layer_prev = 0.0 + if (K < nk+1) then + pbv%por_face_areaU(I,j,k) = 0.0; endif + else + call calc_por_layer(US%Z_to_m*(G%porous_DminU(I,j)-G%Z_ref), & + US%Z_to_m*(G%porous_DmaxU(I,j)-G%Z_ref), & + US%Z_to_m*(G%porous_DavgU(I,j)-G%Z_ref), eta_s, w_layer, A_layer) + pbv%por_layer_widthU(I,j,K) = w_layer + if (k <= nk) then + if ((eta_s - eta_prev) > 0.0) then + pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev)/& (eta_s-eta_prev) - else - pbv%por_face_areaU(I,j,k) = 0.0; endif - endif - eta_prev = eta_s - A_layer_prev = A_layer - endif; enddo - endif; enddo; enddo + else + pbv%por_face_areaU(I,j,k) = 0.0; endif + endif + eta_prev = eta_s + A_layer_prev = A_layer + endif + enddo + endif + enddo; enddo do i=isd,ied; do J=JsdB,JedB - if (G%porous_DavgV(i,J) < 0.) then - do K = nk+1,1,-1 - eta_s = max(US%Z_to_m*eta(i,J,K), US%Z_to_m*eta(i,J+1,K)) !take shallower layer height - !eta_s = 0.5 * (US%Z_to_m*eta(i,J,K) + US%Z_to_m*eta(i,J+1,K)) !take arithmetic mean - if (eta_s <= G%porous_DminV(i,J)) then - pbv%por_layer_widthV(i,J,K) = 0.0 - A_layer_prev = 0.0 - if (K < nk+1) then - pbv%por_face_areaV(i,J,k) = 0.0; endif - else - call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J),& - eta_s, w_layer, A_layer) - pbv%por_layer_widthV(i,J,K) = w_layer - if (k <= nk) then - if ((eta_s - eta_prev) > 0.0) then - pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev)/& + if (G%porous_DavgV(i,J) < 0.) then + do K = nk+1,1,-1 + eta_s = max(US%Z_to_m*eta(i,J,K), US%Z_to_m*eta(i,J+1,K)) !take shallower layer height + !eta_s = 0.5 * (US%Z_to_m*eta(i,J,K) + US%Z_to_m*eta(i,J+1,K)) !take arithmetic mean + if (eta_s <= G%porous_DminV(i,J)) then + pbv%por_layer_widthV(i,J,K) = 0.0 + A_layer_prev = 0.0 + if (K < nk+1) then + pbv%por_face_areaV(i,J,k) = 0.0; endif + else + call calc_por_layer(US%Z_to_m*(G%porous_DminV(i,J)-G%Z_ref), & + US%Z_to_m*(G%porous_DmaxV(i,J)-G%Z_ref), & + US%Z_to_m*(G%porous_DavgV(i,J)-G%Z_ref), eta_s, w_layer, A_layer) + pbv%por_layer_widthV(i,J,K) = w_layer + if (k <= nk) then + if ((eta_s - eta_prev) > 0.0) then + pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev)/& (eta_s-eta_prev) - else - pbv%por_face_areaU(I,j,k) = 0.0; endif - endif - eta_prev = eta_s - A_layer_prev = A_layer - endif; enddo - endif; enddo; enddo + else + pbv%por_face_areaU(I,j,k) = 0.0; endif + endif + eta_prev = eta_s + A_layer_prev = A_layer + endif + enddo + endif + enddo; enddo end subroutine por_widths +!> subroutine to calculate the profile fit for a single layer in a column subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) -!subroutine to calculate the profile fit for a layer real, intent(in) :: D_min !< minimum topographic height [m] real, intent(in) :: D_max !< maximum topographic height [m] @@ -140,24 +146,24 @@ subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) zeta = (eta_layer - D_min)/(D_max - D_min) if (eta_layer <= D_min) then - w_layer = 0.0 - A_layer = 0.0 + w_layer = 0.0 + A_layer = 0.0 elseif (eta_layer >= D_max) then - w_layer = 1.0 - A_layer = eta_layer - D_avg + w_layer = 1.0 + A_layer = eta_layer - D_avg else - if (m < 0.5) then - psi = zeta**(1./a) - psi_int = (1.-m)*zeta**(1./(1.-m)) - elseif (m == 0.5) then - psi = zeta - psi_int = 0.5*zeta*zeta - else - psi = 1. - (1. - zeta)**a - psi_int = zeta - m + m*((1-zeta)**(1/m)) - endif - w_layer = psi - A_layer = (D_max - D_min)*psi_int + if (m < 0.5) then + psi = zeta**(1./a) + psi_int = (1.-m)*zeta**(1./(1.-m)) + elseif (m == 0.5) then + psi = zeta + psi_int = 0.5*zeta*zeta + else + psi = 1. - (1. - zeta)**a + psi_int = zeta - m + m*((1-zeta)**(1/m)) + endif + w_layer = psi + A_layer = (D_max - D_min)*psi_int endif diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index e19df5b6c6..0e6d681896 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -71,9 +71,9 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dyCu(I,j) = dG%dyCu(I+ido,j+jdo) oG%dy_Cu(I,j) = dG%dy_Cu(I+ido,j+jdo) - oG%porous_DminU(I,j) = dG%porous_DminU(I+ido,j+jdo) - oG%porous_DmaxU(I,j) = dG%porous_DmaxU(I+ido,j+jdo) - oG%porous_DavgU(I,j) = dG%porous_DavgU(I+ido,j+jdo) + oG%porous_DminU(I,j) = dG%porous_DminU(I+ido,j+jdo) - oG%Z_ref + oG%porous_DmaxU(I,j) = dG%porous_DmaxU(I+ido,j+jdo) - oG%Z_ref + oG%porous_DavgU(I,j) = dG%porous_DavgU(I+ido,j+jdo) - oG%Z_ref oG%mask2dCu(I,j) = dG%mask2dCu(I+ido,j+jdo) oG%areaCu(I,j) = dG%areaCu(I+ido,j+jdo) @@ -87,9 +87,9 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dyCv(i,J) = dG%dyCv(i+ido,J+jdo) oG%dx_Cv(i,J) = dG%dx_Cv(i+ido,J+jdo) - oG%porous_DminV(i,J) = dG%porous_DminV(i+ido,J+jdo) - oG%porous_DmaxV(i,J) = dG%porous_DmaxV(i+ido,J+jdo) - oG%porous_DavgV(i,J) = dG%porous_DavgV(i+ido,J+jdo) + oG%porous_DminV(i,J) = dG%porous_DminV(i+ido,J+jdo) - oG%Z_ref + oG%porous_DmaxV(i,J) = dG%porous_DmaxV(i+ido,J+jdo) - oG%Z_ref + oG%porous_DavgV(i,J) = dG%porous_DavgV(i+ido,J+jdo) - oG%Z_ref oG%mask2dCv(i,J) = dG%mask2dCv(i+ido,J+jdo) oG%areaCv(i,J) = dG%areaCv(i+ido,J+jdo) @@ -224,9 +224,9 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dyCu(I,j) = oG%dyCu(I+ido,j+jdo) dG%dy_Cu(I,j) = oG%dy_Cu(I+ido,j+jdo) - dG%porous_DminU(I,j) = oG%porous_DminU(I+ido,j+jdo) - dG%porous_DmaxU(I,j) = oG%porous_DmaxU(I+ido,j+jdo) - dG%porous_DavgU(I,j) = oG%porous_DavgU(I+ido,j+jdo) + dG%porous_DminU(I,j) = oG%porous_DminU(I+ido,j+jdo) + oG%Z_ref + dG%porous_DmaxU(I,j) = oG%porous_DmaxU(I+ido,j+jdo) + oG%Z_ref + dG%porous_DavgU(I,j) = oG%porous_DavgU(I+ido,j+jdo) + oG%Z_ref dG%mask2dCu(I,j) = oG%mask2dCu(I+ido,j+jdo) dG%areaCu(I,j) = oG%areaCu(I+ido,j+jdo) @@ -240,9 +240,9 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dyCv(i,J) = oG%dyCv(i+ido,J+jdo) dG%dx_Cv(i,J) = oG%dx_Cv(i+ido,J+jdo) - dG%porous_DminV(i,J) = oG%porous_DminU(i+ido,J+jdo) - dG%porous_DmaxV(i,J) = oG%porous_DmaxU(i+ido,J+jdo) - dG%porous_DavgV(i,J) = oG%porous_DavgU(i+ido,J+jdo) + dG%porous_DminV(i,J) = oG%porous_DminU(i+ido,J+jdo) + oG%Z_ref + dG%porous_DmaxV(i,J) = oG%porous_DmaxU(i+ido,J+jdo) + oG%Z_ref + dG%porous_DavgV(i,J) = oG%porous_DavgU(i+ido,J+jdo) + oG%Z_ref dG%mask2dCv(i,J) = oG%mask2dCv(i+ido,J+jdo) dG%areaCv(i,J) = oG%areaCv(i+ido,J+jdo) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 49d3dc01c7..efa3b02b2b 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -110,14 +110,14 @@ module MOM_dyn_horgrid areaCv !< The areas of the v-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & - porous_DminU, & !< minimum topographic height of U-face [m] - porous_DmaxU, & !< maximum topographic height of U-face [m] - porous_DavgU !< average topographic height of U-face [m] + porous_DminU, & !< minimum topographic height of U-face [Z ~> m] + porous_DmaxU, & !< maximum topographic height of U-face [Z ~> m] + porous_DavgU !< average topographic height of U-face [Z ~> m] real, allocatable, dimension(:,:) :: & - porous_DminV, & !< minimum topographic height of V-face [m] - porous_DmaxV, & !< maximum topographic height of V-face [m] - porous_DavgV !< average topographic height of V-face [m] + porous_DminV, & !< minimum topographic height of V-face [Z ~> m] + porous_DmaxV, & !< maximum topographic height of V-face [Z ~> m] + porous_DavgV !< average topographic height of V-face [Z ~> m] real, allocatable, dimension(:,:) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index e9531bb4e2..8f1a309d5f 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -856,6 +856,7 @@ subroutine reset_face_lengths_list(G, param_file, US) Dmin_v, Dmax_v, Davg_v real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] + real :: m_to_Z ! A unit conversion factor [L ~> m] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -878,6 +879,7 @@ subroutine reset_face_lengths_list(G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -971,9 +973,9 @@ subroutine reset_face_lengths_list(G, param_file, US) if (found_u) then u_pt = u_pt + 1 if (found_u_por .eqv. .false.) then - read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) + read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) elseif (found_u_por) then - read(line(isu_por+12:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt), & + read(line(isu_por+12:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt), & Dmin_u(u_pt), Dmax_u(u_pt), Davg_u(u_pt) endif u_line_no(u_pt) = ln @@ -1008,9 +1010,9 @@ subroutine reset_face_lengths_list(G, param_file, US) elseif (found_v) then v_pt = v_pt + 1 if (found_v_por .eqv. .false.) then - read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) + read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) elseif (found_v_por) then - read(line(isv+12:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt), & + read(line(isv+12:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt), & Dmin_v(v_pt), Dmax_v(v_pt), Davg_v(v_pt) endif v_line_no(v_pt) = ln @@ -1059,9 +1061,9 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(L_to_m*G%dyCu(I,j), max(u_width(npt), 0.0)) - G%porous_DminU(I,j) = Dmin_u(npt) - G%porous_DmaxU(I,j) = Dmax_u(npt) - G%porous_DavgU(I,j) = Davg_u(npt) + G%porous_DminU(I,j) = m_to_Z*Dmin_u(npt) + G%porous_DmaxU(I,j) = m_to_Z*Dmax_u(npt) + G%porous_DavgU(I,j) = m_to_Z*Davg_u(npt) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then @@ -1096,9 +1098,9 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(L_to_m*G%dxCv(i,J), max(v_width(npt), 0.0)) - G%porous_DminV(i,J) = Dmin_v(npt) - G%porous_DmaxV(i,J) = Dmax_v(npt) - G%porous_DavgV(i,J) = Davg_v(npt) + G%porous_DminV(i,J) = m_to_Z*Dmin_v(npt) + G%porous_DmaxV(i,J) = m_to_Z*Dmax_v(npt) + G%porous_DavgV(i,J) = m_to_Z*Davg_v(npt) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(stdout,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& From be50361cd72d1cad0bb990a17c9c6291b623f86f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 22 Nov 2021 07:19:33 -0500 Subject: [PATCH 063/138] Add initialization tests using CS%initialized Added a new variable, initialized, to the control structures of modules that had been testing for an allocated control structure to verify that it had been initialized before it was going to be used, and then duplicated the tests using this new variable. This was done to enable us to go ahead with MOM6 PR #5, which eliminated many of these checks when converting the control structures from pointers in the parent modules to elements that are always there, and then passing them as simple types instead of as pointers. If we decide that we do not need these tests after all, we can easily delete them, but until this is discussed, this commit avoids losing the messages, as it was easier to do it this way instead of trying to recreate them after they had been removed. All answers and output are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 7 ++ src/core/MOM_PressureForce_FV.F90 | 10 ++ src/core/MOM_PressureForce_Montgomery.F90 | 11 ++ src/core/MOM_barotropic.F90 | 16 +++ src/core/MOM_continuity_PPM.F90 | 7 ++ src/diagnostics/MOM_diagnostics.F90 | 9 ++ src/diagnostics/MOM_sum_output.F90 | 7 ++ src/diagnostics/MOM_wave_speed.F90 | 12 ++ src/diagnostics/MOM_wave_structure.F90 | 6 + src/framework/MOM_restart.F90 | 108 ++++++++++++++++++ src/framework/MOM_write_cputime.F90 | 6 + src/parameterizations/lateral/MOM_MEKE.F90 | 6 + .../lateral/MOM_hor_visc.F90 | 8 ++ .../lateral/MOM_lateral_mixing_coeffs.F90 | 23 ++++ .../lateral/MOM_mixed_layer_restrat.F90 | 10 ++ .../lateral/MOM_thickness_diffuse.F90 | 6 + .../vertical/MOM_bulk_mixed_layer.F90 | 7 ++ .../vertical/MOM_diabatic_driver.F90 | 7 ++ .../vertical/MOM_diapyc_energy_req.F90 | 3 + .../vertical/MOM_energetic_PBL.F90 | 6 + .../vertical/MOM_entrain_diffusive.F90 | 6 + .../vertical/MOM_geothermal.F90 | 11 ++ .../vertical/MOM_internal_tide_input.F90 | 6 + .../vertical/MOM_regularize_layers.F90 | 9 ++ .../vertical/MOM_set_diffusivity.F90 | 9 ++ .../vertical/MOM_set_viscosity.F90 | 11 ++ .../vertical/MOM_vert_friction.F90 | 12 ++ src/user/user_change_diffusivity.F90 | 6 + 28 files changed, 345 insertions(+) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 3a3ba6920c..670d1a2fca 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -25,6 +25,7 @@ module MOM_CoriolisAdv !> Control structure for mom_coriolisadv type, public :: CoriolisAdv_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. integer :: Coriolis_Scheme !< Selects the discretization for the Coriolis terms. !! Valid values are: !! - SADOURNY75_ENERGY - Sadourny, 1975 @@ -247,6 +248,10 @@ 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.") + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_CoriolisAdv: Module must be initialized before it is used.") + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke vol_neglect = GV%H_subroundoff * (1e-4 * US%m_to_L)**2 @@ -1131,6 +1136,8 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) endif allocate(CS) + CS%initialized = .true. + CS%diag => diag ; CS%Time => Time ! Read all relevant parameters and write them to the model log. diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 3100699e6f..734be4c758 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -34,6 +34,7 @@ module MOM_PressureForce_FV !> Finite volume pressure gradient control structure type, public :: PressureForce_FV_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq !! approximation [R ~> kg m-3]. @@ -165,6 +166,10 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_PressureForce_FV_nonBouss: Module must be initialized before it is used.") + if (CS%Stanley_T2_det_coeff>=0.) call MOM_error(FATAL, & "MOM_PressureForce_FV_nonBouss: The Stanley parameterization is not yet"//& "implemented in non-Boussinesq mode.") @@ -502,6 +507,9 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_FV_Bouss: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_PressureForce_FV_Bouss: Module must be initialized before it is used.") + use_p_atm = associated(p_atm) use_EOS = associated(tv%eqn_of_state) do i=Isq,Ieq+1 ; p0(i) = 0.0 ; enddo @@ -820,6 +828,8 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS return else ; allocate(CS) ; endif + CS%initialized = .true. + CS%diag => diag ; CS%Time => Time if (associated(tides_CSp)) CS%tides_CSp => tides_CSp diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 27aaf49276..1aa4d9c384 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -30,6 +30,7 @@ module MOM_PressureForce_Mont !> Control structure for the Montgomery potential form of pressure gradient type, public :: PressureForce_Mont_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq !! approximation [R ~> kg m-3]. @@ -139,6 +140,10 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_Mont: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_PressureForce_Mont: Module must be initialized before it is used.") + if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_nonBouss: The Montgomery form of the pressure force "//& @@ -426,6 +431,10 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_PressureForce_Mont: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_PressureForce_Mont: Module must be initialized before it is used.") + if (use_EOS) then if (query_compressible(tv%eqn_of_state)) call MOM_error(FATAL, & "PressureForce_Mont_Bouss: The Montgomery form of the pressure force "//& @@ -839,6 +848,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ return else ; allocate(CS) ; endif + CS%initialized = .true. + CS%diag => diag ; CS%Time => Time if (associated(tides_CSp)) CS%tides_CSp => tides_CSp diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 219d22cc93..a90deeaf58 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -697,6 +697,10 @@ 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%module_is_initialized) call MOM_error(FATAL, & + "btstep: Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -2769,6 +2773,10 @@ 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%module_is_initialized) call MOM_error(FATAL, & + "set_dtbt: Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed @@ -3306,6 +3314,10 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-). if (.not.associated(CS)) call MOM_error(FATAL, & "btcalc: Module MOM_barotropic must be initialized before it is used.") + + if (.not.CS%module_is_initialized) call MOM_error(FATAL, & + "btcalc: Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return use_default = .false. @@ -4198,6 +4210,10 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL, "bt_mass_source: "// & "Module MOM_barotropic must be initialized before it is used.") + + if (.not.CS%module_is_initialized) call MOM_error(FATAL, "bt_mass_source: "// & + "Module MOM_barotropic must be initialized before it is used.") + if (.not.CS%split) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a9cd01a6df..35965402bb 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -26,6 +26,7 @@ module MOM_continuity_PPM !> Control structure for mom_continuity_ppm type, public :: continuity_PPM_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. type(diag_ctrl), pointer :: diag !< Diagnostics control structure. logical :: upwind_1st !< If true, use a first-order upwind scheme. logical :: monotonic !< If true, use the Colella & Woodward monotonic @@ -136,6 +137,10 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, uhbt, vh if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_continuity_PPM: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_continuity_PPM: Module must be initialized before it is used.") + x_first = (MOD(G%first_direction,2) == 0) if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & @@ -2210,6 +2215,8 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) endif allocate(CS) + CS%initialized = .true. + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MONOTONIC_CONTINUITY", CS%monotonic, & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7817fc4959..428b6f79ae 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -49,6 +49,7 @@ module MOM_diagnostics !> The control structure for the MOM_diagnostics module type, public :: diagnostics_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as !! monotonic for the purposes of calculating the equivalent !! barotropic wave speed. @@ -272,6 +273,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (loc(CS)==0) call MOM_error(FATAL, & "calculate_diagnostic_fields: Module must be initialized before used.") + if (.not. CS%initialized) call MOM_error(FATAL, & + "calculate_diagnostic_fields: Module must be initialized before used.") + call calculate_derivs(dt, G, CS) if (dt > 0.0) then @@ -1253,6 +1257,9 @@ subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) if (.not.associated(CS)) call MOM_error(FATAL, & "register_time_deriv: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, & + "register_time_deriv: Module must be initialized before it is used.") + if (CS%num_time_deriv >= MAX_FIELDS_) then call MOM_error(WARNING,"MOM_diagnostics: Attempted to register more than " // & "MAX_FIELDS_ diagnostic time derivatives via register_time_deriv.") @@ -1620,6 +1627,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif allocate(CS) + CS%initialized = .true. + CS%diag => diag use_temperature = associated(tv%T) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 602041372b..4c70245a1f 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -59,6 +59,8 @@ module MOM_sum_output !> The control structure for the MOM_sum_output module type, public :: sum_output_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. + type(Depth_List) :: DL !< The sorted depth list. integer, allocatable, dimension(:) :: lH @@ -160,6 +162,8 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & endif allocate(CS) + CS%initialized = .true. + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "CALCULATE_APE", CS%do_APE_calc, & @@ -490,6 +494,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, & + "write_energy: Module must be initialized before it is used.") + do j=js,je ; do i=is,ie areaTm(i,j) = G%mask2dT(i,j)*G%areaT(i,j) enddo ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 833e7d8165..dd6777d032 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -26,6 +26,7 @@ module MOM_wave_speed !> Control structure for MOM_wave_speed type, public :: wave_speed_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: use_ebt_mode = .false. !< If true, calculate the equivalent barotropic wave speed instead !! of the first baroclinic wave speed. !! This parameter controls the default behavior of wave_speed() which @@ -149,6 +150,10 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ if (.not. associated(CS)) call MOM_error(FATAL, "MOM_wave_speed: "// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & + "Module must be initialized before it is used.") + if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif @@ -731,6 +736,11 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) "Module must be initialized before it is used.") endif + if (present(CS)) then + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & + "Module must be initialized before it is used.") + endif + if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif @@ -1200,6 +1210,8 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de return else ; allocate(CS) ; endif + CS%initialized = .true. + ! Write all relevant parameters to the model log. call log_version(mdl, version) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index cf4c518889..41464845ae 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -36,6 +36,7 @@ module MOM_wave_structure !> The control structure for the MOM_wave_structure module type, public :: wave_structure_CS ; !private + logical :: initialized = .false. !< True if this control structure has been initialized. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. real, allocatable, dimension(:,:,:) :: w_strct @@ -198,6 +199,9 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo "Module must be initialized before it is used.") !endif + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_structure: "// & + "Module must be initialized before it is used.") + if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif @@ -742,6 +746,8 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) return else ; allocate(CS) ; endif + CS%initialized = .true. + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 5d81db10a3..8dcae65d52 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -69,6 +69,7 @@ module MOM_restart !> A restart registry and the control structure for restarts type, public :: MOM_restart_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: restart !< restart is set to .true. if the run has been started from a full restart !! file. Otherwise some fields must be initialized approximately. integer :: novars = 0 !< The number of restart fields that have been registered. @@ -156,6 +157,9 @@ subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) CS%novars = CS%novars+1 @@ -189,6 +193,9 @@ subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) CS%novars = CS%novars+1 @@ -222,6 +229,9 @@ subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) CS%novars = CS%novars+1 @@ -254,6 +264,9 @@ subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) CS%novars = CS%novars+1 @@ -286,6 +299,9 @@ subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) CS%novars = CS%novars+1 @@ -397,6 +413,10 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units "register_restart_field_4d: Module must be initialized before "//& "it is used to register "//trim(name)) + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & + "register_restart_field_4d: Module must be initialized before "//& + "it is used to register "//trim(name)) + call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & @@ -427,6 +447,10 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units "register_restart_field_3d: Module must be initialized before "//& "it is used to register "//trim(name)) + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & + "register_restart_field_3d: Module must be initialized before "//& + "it is used to register "//trim(name)) + call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & @@ -457,6 +481,11 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_2d: Module must be initialized before "//& "it is used to register "//trim(name)) + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & + "register_restart_field_2d: Module must be initialized before "//& + "it is used to register "//trim(name)) + zgrid = '1' ; if (present(z_grid)) zgrid = z_grid call lock_check(CS, name=name) @@ -488,6 +517,11 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_3d: Module must be initialized before "//& "it is used to register "//trim(name)) + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & + "register_restart_field_3d: Module must be initialized before "//& + "it is used to register "//trim(name)) + hgrid = '1' ; if (present(hor_grid)) hgrid = hor_grid call lock_check(CS, name=name) @@ -517,6 +551,10 @@ subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units "register_restart_field_0d: Module must be initialized before "//& "it is used to register "//trim(name)) + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // & + "register_restart_field_0d: Module must be initialized before "//& + "it is used to register "//trim(name)) + call lock_check(CS, name=name) vd = var_desc(name, units=units, longname=longname, hor_grid='1', & @@ -538,6 +576,10 @@ function query_initialized_name(name, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -570,6 +612,10 @@ function query_initialized_0d(f_ptr, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -595,6 +641,10 @@ function query_initialized_1d(f_ptr, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -621,6 +671,10 @@ function query_initialized_2d(f_ptr, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -647,6 +701,10 @@ function query_initialized_3d(f_ptr, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -673,6 +731,10 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -700,6 +762,10 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -734,6 +800,10 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -768,6 +838,10 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -802,6 +876,10 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -836,6 +914,10 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "query_initialized: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) query_initialized = .false. @@ -908,6 +990,10 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "save_restart: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "save_restart: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) ! With parallel read & write, it is possible to disable the following... @@ -1099,6 +1185,10 @@ subroutine restore_state(filename, directory, day, G, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "restore_state: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "restore_state: Module must be initialized before it is used.") + if (CS%novars > CS%max_fields) call restart_error(CS) ! Get NetCDF ids for all of the restart files. @@ -1295,6 +1385,9 @@ function restart_files_exist(filename, directory, G, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "restart_files_exist: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "restart_files_exist: Module must be initialized before it is used.") + if ((LEN_TRIM(filename) == 1) .and. (filename(1:1) == 'F')) then num_files = get_num_restart_files('r', directory, G, CS) else @@ -1320,6 +1413,9 @@ function determine_is_new_run(filename, directory, G, CS) result(is_new_run) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "determine_is_new_run: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "determine_is_new_run: Module must be initialized before it is used.") if (LEN_TRIM(filename) > 1) then CS%new_run = .false. elseif (LEN_TRIM(filename) == 0) then @@ -1346,6 +1442,10 @@ function is_new_run(CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "is_new_run: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "is_new_run: Module must be initialized before it is used.") + if (.not.CS%new_run_set) call MOM_error(FATAL, "MOM_restart " // & "determine_is_new_run must be called for a restart file before is_new_run.") @@ -1391,6 +1491,9 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "open_restart_units: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "open_restart_units: Module must be initialized before it is used.") + ! Get NetCDF ids for all of the restart files. num_restart = 0 ; nf = 0 ; start_char = 1 do while (start_char <= len_trim(filename) ) @@ -1506,6 +1609,9 @@ function get_num_restart_files(filenames, directory, G, CS, file_paths) result(n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "get_num_restart_files: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & + "get_num_restart_files: Module must be initialized before it is used.") + ! This call uses open_restart_units without the optional arguments needed to actually ! open the files to determine the number of restart files. num_files = open_restart_units(filenames, directory, G, CS, file_paths=file_paths) @@ -1535,6 +1641,8 @@ subroutine restart_init(param_file, CS, restart_root) endif allocate(CS) + CS%initialized = .true. + ! Determine whether all paramters are set to their default values. call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", CS%parallel_restartfiles, & default=.false., do_not_log=.true.) diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index c9200cf41c..9df994448b 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -20,6 +20,7 @@ module MOM_write_cputime !> A control structure that regulates the writing of CPU time type, public :: write_cputime_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: maxcpu !< The maximum amount of cpu time per processor !! for which MOM should run before saving a restart !! file and quiting with a return value that @@ -71,6 +72,8 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) CS%prev_cputime = new_cputime endif + CS%initialized = .true. + ! Read all relevant parameters and write them to the model log. ! Determine whether all paramters are set to their default values. @@ -141,6 +144,9 @@ subroutine write_cputime(day, n, CS, nmax, call_end) if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, & + "write_cputime: Module must be initialized before it is used.") + call SYSTEM_CLOCK(new_cputime, CLOCKS_PER_SEC, MAX_TICKS) ! The following lines extract useful information even if the clock has rolled ! over, assuming a 32-bit SYSTEM_CLOCK. With more bits, rollover is essentially diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 588fa4c75e..94b62f1c20 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -29,6 +29,7 @@ module MOM_MEKE !> Control structure that contains MEKE parameters and diagnostics handles type, public :: MEKE_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. ! Parameters real, dimension(:,:), pointer :: equilibrium_value => NULL() !< The equilbrium value !! of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2] @@ -180,6 +181,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_MEKE: Module must be initialized before it is used.") + if ((CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) .or. CS%visc_drag) then use_drag_rate = .true. else @@ -1064,6 +1068,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) return else ; allocate(CS) ; endif + CS%initialized = .true. + call MOM_mesg("MEKE_init: reading parameters ", 5) ! Read all relevant parameters and write them to the model log. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index e0ec7fba63..e3ea65c1a8 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -30,6 +30,7 @@ module MOM_hor_visc !> Control structure for horizontal viscosity type, public :: hor_visc_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: Laplacian !< Use a Laplacian horizontal viscosity if true. logical :: biharmonic !< Use a biharmonic horizontal viscosity if true. logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -421,6 +422,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_hor_visc: Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_hor_visc: Module must be initialized before it is used.") + if (.not.(CS%Laplacian .or. CS%biharmonic)) return find_FrictWork = (CS%id_FrictWork > 0) @@ -1836,6 +1841,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) return endif allocate(CS) + + CS%initialized = .true. + CS%diag => diag ! Read parameters and write them to the model log. call log_version(param_file, mdl, version, "") diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9306233112..ccd583b165 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -25,6 +25,7 @@ module MOM_lateral_mixing_coeffs !> Variable mixing coefficients type, public :: VarMix_CS + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: use_variable_mixing !< If true, use the variable mixing. logical :: Resoln_scaling_used !< If true, a resolution function is used somewhere to scale !! away one of the viscosities or diffusivities when the @@ -177,6 +178,10 @@ subroutine calc_depth_function(G, CS) if (.not. associated(CS)) call MOM_error(FATAL, "calc_depth_function:"// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "calc_depth_function: "// & + "Module must be initialized before it is used.") + if (.not. CS%calculate_depth_fns) return if (.not. associated(CS%Depth_fn_u)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_u is not associated with Depth_scaled_KhTh.") @@ -220,6 +225,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (.not. associated(CS)) call MOM_error(FATAL, "calc_resoln_function:"// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "calc_resoln_function: "// & + "Module must be initialized before it is used.") + if (CS%calculate_cg1) then if (.not. associated(CS%cg1)) call MOM_error(FATAL, & "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") @@ -465,6 +474,9 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions: "//& + "Module must be initialized before it is used.") + if (CS%calculate_Eady_growth_rate) then if (CS%use_simpler_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) @@ -533,6 +545,10 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "calc_Visbeck_coeffs_old: "// & + "Module must be initialized before it is used.") + if (.not. CS%calculate_Eady_growth_rate) return if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") @@ -880,6 +896,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "calc_slope_functions_using_just_e: "// & + "Module must be initialized before it is used.") + if (.not. CS%calculate_Eady_growth_rate) return if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") @@ -1186,6 +1206,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif allocate(CS) + + CS%initialized = .true. + in_use = .false. ! Set to true to avoid deallocating CS%diag => diag ! Diagnostics pointer CS%calculate_cg1 = .false. diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0d2062441e..cb1aa16d44 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -36,6 +36,7 @@ module MOM_mixed_layer_restrat !> Control structure for mom_mixed_layer_restrat type, public :: mixedlayer_restrat_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: ml_restrat_coef !< A non-dimensional factor by which the instability is enhanced !! over what would be predicted based on the resolved gradients !! [nondim]. This increases with grid spacing^2, up to something @@ -107,6 +108,9 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + "Module must be initialized before it is used.") + if (GV%nkml>0) then call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) else @@ -616,6 +620,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + "Module must be initialized before it is used.") + if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 @@ -826,6 +834,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") endif + CS%initialized = .true. + ! Nonsense values to cause problems when these parameters are not used CS%MLE_MLD_decay_time = -9.e9*US%s_to_T CS%MLE_density_diff = -9.e9*US%kg_m3_to_R diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 78425676b1..3f4ca58d0c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -35,6 +35,7 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Khth !< Background interface depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [nondim] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion @@ -164,6 +165,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& + "Module must be initialized before it is used.") + if ((.not.CS%thickness_diffuse) .or. & .not.( CS%Khth > 0.0 .or. associated(VarMix) .or. associated(MEKE) ) ) return @@ -1910,6 +1914,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) return else ; allocate(CS) ; endif + CS%initialized = .true. + CS%diag => diag ! Read all relevant parameters and write them to the model log. diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index be2dfefe8c..d6c1269614 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -30,6 +30,7 @@ module MOM_bulk_mixed_layer !> The control structure with parameters for the MOM_bulk_mixed_layer module type, public :: bulkmixedlayer_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. integer :: nkml !< The number of layers in the mixed layer. integer :: nkbl !< The number of buffer layers. integer :: nsw !< The number of bands of penetrating shortwave radiation. @@ -331,6 +332,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//& "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_bulk_mixed_layer: "//& + "Module must be initialized before it is used.") + if (GV%nkml < 1) return if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & @@ -3383,6 +3388,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) return else ; allocate(CS) ; endif + CS%initialized = .true. + 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 d3f92e99cc..74c7d48db7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -88,6 +88,7 @@ module MOM_diabatic_driver !> Control structure for this module type, public :: diabatic_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: use_legacy_diabatic !< If true (default), use a legacy version of the diabatic !! algorithm. This is temporary and is needed to avoid change @@ -305,6 +306,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "diabatic was called with a zero length timestep.") if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & @@ -2908,6 +2913,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di allocate(CS) endif + CS%initialized = .true. + CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 2cca587e9e..bd50b4ec0a 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -77,6 +77,9 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) if (.not. associated(CS)) call MOM_error(FATAL, "diapyc_energy_req_test: "// & "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "diapyc_energy_req_test: "// & + "Module must be initialized before it is used.") + !$OMP do do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 946a40d39e..8379e1389f 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -32,6 +32,7 @@ module MOM_energetic_PBL !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. !/ Constants real :: VonKar = 0.41 !< The von Karman coefficient. This should be a runtime parameter, @@ -348,6 +349,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "energetic_PBL: "//& + "Module must be initialized before it is used.") + if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & "energetic_PBL: Temperature, salinity and an equation of state "//& "must now be used.") @@ -1938,6 +1942,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) return else ; allocate(CS) ; endif + CS%initialized = .true. + CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 4dc08284af..f6ae73857c 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -27,6 +27,7 @@ module MOM_entrain_diffusive !> The control structure holding parametes for the MOM_entrain_diffusive module type, public :: entrain_diffusive_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! GV%nk_rho_varies variable density mixed & buffer layers. integer :: max_ent_it !< The maximum number of iterations that may be used to @@ -210,6 +211,9 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & if (.not. associated(CS)) call MOM_error(FATAL, & "MOM_entrain_diffusive: Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, & + "MOM_entrain_diffusive: Module must be initialized before it is used.") + if (.not.(present(Kd_Lay) .or. present(Kd_int))) call MOM_error(FATAL, & "MOM_entrain_diffusive: Either Kd_Lay or Kd_int must be present in call.") @@ -2087,6 +2091,8 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re endif allocate(CS) + CS%initialized = .true. + CS%diag => diag CS%bulkmixedlayer = (GV%nkml > 0) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 877f9a0497..802254ee01 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -23,6 +23,7 @@ module MOM_geothermal !> Control structure for geothermal heating type, public :: geothermal_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is negative) the !! water is heated in place instead of moving upward between !! layers in non-ALE layered mode [R degC-1 ~> kg m-3 degC-1] @@ -121,6 +122,10 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_geothermal: "//& + "Module must be initialized before it is used.") + if (.not.CS%apply_geothermal) return nkmb = GV%nk_rho_varies @@ -397,6 +402,10 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& "Module must be initialized before it is used.") + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_geothermal: "//& + "Module must be initialized before it is used.") + if (.not.CS%apply_geothermal) return Irho_cp = 1.0 / (GV%H_to_RZ * tv%C_p) @@ -518,6 +527,8 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith return else ; allocate(CS) ; endif + CS%initialized = .true. + CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index df24d3f4e9..300cdcbe1e 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -34,6 +34,7 @@ module MOM_int_tide_input !> This control structure holds parameters that regulate internal tide energy inputs. type, public :: int_tide_input_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: debug !< If true, write verbose checksums for debugging. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -111,6 +112,9 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"set_diffusivity: "//& + "Module must be initialized before it is used.") + use_EOS = associated(tv%eqn_of_state) ! Smooth the properties through massless layers. @@ -330,6 +334,8 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) allocate(CS) allocate(itide) + CS%initialized = .true. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index af92e522a2..79d6d064c7 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -23,6 +23,7 @@ module MOM_regularize_layers !> This control structure holds parameters used by the MOM_regularize_layers module type, public :: regularize_layers_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: regularize_surface_layers !< If true, vertically restructure the !! near-surface layers when they have too much !! lateral variations to allow for sensible lateral @@ -96,6 +97,9 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_regularize_layers: "//& + "Module must be initialized before it is used.") + if (CS%regularize_surface_layers) then call pass_var(h, G%Domain, clock=id_clock_pass) call regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) @@ -197,6 +201,9 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& "Module must be initialized before it is used.") + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_regularize_layers: "//& + "Module must be initialized before it is used.") + if (GV%nkml<1) return nkmb = GV%nk_rho_varies ; nkml = GV%nkml if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, & @@ -735,6 +742,8 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) return else ; allocate(CS) ; endif + CS%initialized = .true. + CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b1a4d1433d..89a426d0cd 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -56,6 +56,7 @@ module MOM_set_diffusivity !> This control structure contains parameters for MOM_set_diffusivity. type, public :: set_diffusivity_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. logical :: debug !< If true, write verbose checksums for debugging. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with @@ -282,6 +283,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"set_diffusivity: "//& + "Module must be initialized before it is used.") + if (CS%answers_2018) then ! These hard-coded dimensional parameters are being replaced. kappa_dt_fill = US%m_to_Z**2 * 1.e-3 * 7200. @@ -1707,6 +1711,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) if (.not.associated(CS)) call MOM_error(FATAL,"set_BBL_TKE: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"set_BBL_TKE: "//& + "Module must be initialized before it is used.") + if (.not.CS%bottomdraglaw .or. (CS%BBL_effic<=0.0)) then if (associated(visc%ustar_BBL)) then do j=js,je ; do i=is,ie ; visc%ustar_BBL(i,j) = 0.0 ; enddo ; enddo @@ -1986,6 +1993,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ endif allocate(CS) + CS%initialized = .true. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1cf3b5ddc9..ca7964c43c 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -43,6 +43,7 @@ module MOM_set_visc !> Control structure for MOM_set_visc type, public :: set_visc_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. !! Runtime parameter `HBBL`. real :: cdrag !< The quadratic drag coefficient. @@ -286,6 +287,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& "Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& + "Module must be initialized before it is used.") + if (.not.CS%bottomdraglaw) return if (CS%debug) then @@ -1249,6 +1254,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_set_viscosity(visc_ML): "//& "Module must be initialized before it is used.") + + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_set_viscosity(visc_ML): "//& + "Module must be initialized before it is used.") + if (.not.(CS%dynamic_viscous_ML .or. associated(forces%frac_shelf_u) .or. & associated(forces%frac_shelf_v)) ) return @@ -1939,6 +1948,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif allocate(CS) + CS%initialized = .true. + CS%OBC => OBC is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d0d3943a26..f36af41149 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -37,6 +37,7 @@ module MOM_vert_friction !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. @@ -236,6 +237,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & + "Module must be initialized before it is used.") + if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix @@ -648,6 +652,9 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(remant): "// & + "Module must be initialized before it is used.") + dt_Z_to_H = dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -800,6 +807,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(coef): "// & "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(coef): "// & + "Module must be initialized before it is used.") + h_neglect = GV%H_subroundoff a_cpl_max = 1.0e37 * US%m_to_Z * US%T_to_s I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) @@ -1704,6 +1714,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & endif allocate(CS) + CS%initialized = .true. + if (GV%Boussinesq) then; thickness_units = "m" else; thickness_units = "kg m-2"; endif diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 92570e3caa..0308a3b008 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -25,6 +25,7 @@ module user_change_diffusivity !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. real :: Kd_add !< The scale of a diffusivity that is added everywhere !! without any filtering or scaling [Z2 T-1 ~> m2 s-1]. real :: lat_range(4) !< 4 values that define the latitude range over which @@ -86,6 +87,9 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i if (.not.associated(CS)) call MOM_error(FATAL,"user_set_diffusivity: "//& "Module must be initialized before it is used.") + if (.not.CS%initialized) call MOM_error(FATAL,"user_set_diffusivity: "//& + "Module must be initialized before it is used.") + use_EOS = associated(tv%eqn_of_state) if (.not.use_EOS) return store_Kd_add = .false. @@ -214,6 +218,8 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS) endif allocate(CS) + CS%initialized = .true. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec CS%diag => diag From 4e67533b2db8b7c4c4d338697209040036290dbd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 22 Nov 2021 20:05:50 -0500 Subject: [PATCH 064/138] Corrected the descriptions of 60 variables Corrected the units or made other clarifications in comments describing 60 variables in 28 files. In addition three unused (and unscaled) variables were eliminated. All answers and output are bitwise identical. --- src/ALE/MOM_regridding.F90 | 10 +++++----- src/core/MOM.F90 | 3 ++- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_density_integrals.F90 | 4 ++-- src/core/MOM_open_boundary.F90 | 15 +++++++++------ src/core/MOM_variables.F90 | 4 ++-- src/diagnostics/MOM_diagnostics.F90 | 8 ++++---- src/diagnostics/MOM_sum_output.F90 | 13 +++++-------- src/diagnostics/MOM_wave_speed.F90 | 2 +- src/initialization/MOM_coord_initialization.F90 | 6 +++--- src/initialization/MOM_fixed_initialization.F90 | 8 ++++---- src/initialization/MOM_shared_initialization.F90 | 3 ++- src/initialization/MOM_state_initialization.F90 | 14 +++++++------- src/parameterizations/lateral/MOM_MEKE.F90 | 3 ++- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 10 +++++----- .../vertical/MOM_diapyc_energy_req.F90 | 2 +- src/parameterizations/vertical/MOM_opacity.F90 | 6 +++--- .../vertical/MOM_set_viscosity.F90 | 2 +- .../vertical/MOM_tidal_mixing.F90 | 16 ++++++++-------- src/user/BFB_initialization.F90 | 2 +- src/user/BFB_surface_forcing.F90 | 4 ---- src/user/DOME2d_initialization.F90 | 4 ++-- src/user/DOME_initialization.F90 | 4 ++-- src/user/ISOMIP_initialization.F90 | 4 ++-- src/user/Phillips_initialization.F90 | 2 +- src/user/RGC_initialization.F90 | 4 ++-- src/user/user_initialization.F90 | 2 +- 28 files changed, 79 insertions(+), 80 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 35dcdaa819..94d7852851 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1275,8 +1275,8 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel !! [H ~> m or kg m-2] type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional - !! ice shelf coverage [nodim] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice + !! shelf coverage [nondim] ! Local variables integer :: nz integer :: i, j, k @@ -1412,14 +1412,14 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she type(regridding_CS), intent(in) :: CS !< Regridding control structure real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional - !! ice shelf coverage [nodim] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice shelf + !! coverage [nondim] ! Local variables real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [Pa] + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [R L2 T-2 ~> Pa] integer :: i, j, k, nki real :: depth, nominalDepth real :: h_neglect, h_neglect_edge diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3dc12c57e7..d3c3570ca2 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1711,7 +1711,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB - real :: dtbt ! The barotropic timestep [s] + real :: dtbt ! If negative, this specifies the barotropic timestep as a fraction + ! of the maximum stable value [nondim]. real, allocatable, dimension(:,:) :: eta ! free surface height or column mass [H ~> m or kg m-2] real, allocatable, dimension(:,:) :: area_shelf_in ! area occupied by ice shelf [L2 ~> m2] diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 32eb036a94..c434d7f893 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -190,7 +190,7 @@ module MOM_barotropic logical :: integral_bt_cont !< If true, use the time-integrated velocity over the barotropic steps !! to determine the integrated transports used to update the continuity !! equation. Otherwise the transports are the sum of the transports - !! based on ]a series of instantaneous velocities and the BT_CONT_TYPE + !! based on a series of instantaneous velocities and the BT_CONT_TYPE !! for transports. This is only valid if a BT_CONT_TYPE is used. logical :: Nonlinear_continuity !< If true, the barotropic continuity equation !! uses the full ocean thickness for transport. diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 9fb4fdabcc..3bdca94af3 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -802,7 +802,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & !! subtracted out to reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density [R ~> kg m-3] or [kg m-3], that is used to calculate !! the pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration [m s-2] + real, intent(in) :: G_e !< The Earth's gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real, intent(in) :: dz_subroundoff !< A minuscule thickness change [Z ~> m] real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m] @@ -1457,7 +1457,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim] real :: T_top, T_bot, S_top, S_bot, P_top, P_bot - real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1] + real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] or [m3 kg-1] real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa] real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [R L2 T-2 ~> Pa] real :: hWght ! A pressure-thickness below topography [R L2 T-2 ~> Pa] diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 581cd5e68e..cb9422a412 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3730,13 +3730,16 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain integer :: ishift, jshift ! offsets for staggered locations real, dimension(:,:,:), allocatable, target :: tmp_buffer - real, dimension(:), allocatable :: h_stack + real, dimension(:), allocatable :: h_stack ! Thicknesses at corner points [H ~> m or kg m-2] integer :: is_obc2, js_obc2 - real :: net_H_src, net_H_int, scl_fac - real :: tidal_vel, tidal_elev - real, allocatable :: normal_trans_bt(:,:) ! barotropic transport + real :: net_H_src ! Total thickness of the incoming flow in the source field [H ~> m or kg m-2] + real :: net_H_int ! Total thickness of the incoming flow in the model [H ~> m or kg m-2] + real :: scl_fac ! A nondimensional scaling factor [nondim] + real :: tidal_vel ! Tangential tidal velocity [m s-1] + real :: tidal_elev ! Tidal elevation at an OBC point [m] + real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1] integer :: turns ! Number of index quarter turns - real :: time_delta ! Time since tidal reference date + real :: time_delta ! Time since tidal reference date [s] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -5110,7 +5113,7 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) integer :: i, j, k, is, ie, js, je, nz, contractions, dilations integer :: n - real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] + real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights [Z ~> m] real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] real :: hTmp, eTmp, dilate character(len=100) :: mesg diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 363f3eebfb..c410ce094e 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -67,7 +67,7 @@ module MOM_variables logical :: T_is_conT = .false. !< If true, the temperature variable SST is actually the !! conservative temperature in [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the - !! absolute salinity in [g/kg]. + !! absolute salinity in [gSalt kg-1]. type(coupler_2d_bc_type) :: tr_fields !< A structure that may contain an !! array of named fields describing tracer-related quantities. !### NOTE: ALL OF THE ARRAYS IN TR_FIELDS USE THE COUPLER'S INDEXING CONVENTION AND HAVE NO @@ -95,7 +95,7 @@ module MOM_variables logical :: T_is_conT = .false. !< If true, the temperature variable tv%T is !! actually the conservative temperature [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is - !! actually the absolute salinity in units of [gSalt/kg]. + !! actually the absolute salinity in units of [gSalt kg-1]. real :: min_salinity = 0.01 !< The minimum value of salinity when BOUND_SALINITY=True [ppt]. !! The default is 0.01 for backward compatibility but should be 0. ! These arrays are accumulated fluxes for communication with other components. diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index bcee812c73..8b5c117402 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -94,8 +94,8 @@ module MOM_diagnostics ! The following arrays hold diagnostics in the layer-integrated energy budget. real, allocatable :: KE(:,:,:) !< KE per unit mass [L2 T-2 ~> m2 s-2] real, allocatable :: dKE_dt(:,:,:) !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] - real, allocatable :: PE_to_KE(:,:,:) !< potential energy to KE term [m3 s-3] - real, allocatable :: KE_BT(:,:,:) !< barotropic contribution to KE term [m3 s-3] + real, allocatable :: PE_to_KE(:,:,:) !< potential energy to KE term [H L2 T-3 ~> m3 s-3] + real, allocatable :: KE_BT(:,:,:) !< barotropic contribution to KE term [H L2 T-3 ~> m3 s-3] real, allocatable :: KE_CorAdv(:,:,:) !< KE source from the combined Coriolis and !! advection terms [H L2 T-3 ~> m3 s-3]. !! The Coriolis source should be zero, but is not due to truncation @@ -418,7 +418,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_masso, masso, CS%diag) endif - ! diagnose thickness/volumes of grid cells [m] + ! diagnose thickness/volumes of grid cells [Z ~> m] and [m3] if (CS%id_thkcello>0 .or. CS%id_volcello>0) then if (GV%Boussinesq) then ! thkcello = h for Boussinesq if (CS%id_thkcello > 0) then ; if (GV%H_to_Z == 1.0) then @@ -899,7 +899,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! at the ocean surface [R L2 T-2 ~> Pa]. dpress, & ! Change in hydrostatic pressure across a layer [R L2 T-2 ~> Pa]. tr_int ! vertical integral of a tracer times density, - ! (Rho_0 in a Boussinesq model) [TR kg m-2]. + ! (Rho_0 in a Boussinesq model) [Conc R Z ~> Conc kg m-2]. real :: IG_Earth ! Inverse of gravitational acceleration [T2 Z L-2 ~> s2 m-1]. integer :: i, j, k, is, ie, js, je, nz diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 602041372b..f4021d1549 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -145,11 +145,10 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. ! Local variables - real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS. - real :: Rho_0 ! A reference density [kg m-3] + real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS [s] real :: maxvel ! The maximum permitted velocity [m s-1] -! 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_sum_output" ! This module's name. character(len=200) :: energyfile ! The name of the energy file. character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs @@ -377,11 +376,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci mass_anom_EFP ! The change in fresh water that cannot be accounted for by the surface ! fluxes [kg]. type(EFP_type), dimension(5) :: EFP_list ! An array of EFP types for joint global sums. - real :: CFL_Iarea ! Direction-based inverse area used in CFL test [L-2]. + real :: CFL_Iarea ! Direction-based inverse area used in CFL test [L-2 ~> m-2]. real :: CFL_trans ! A transport-based definition of the CFL number [nondim]. 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_(GV)) :: & tmp1 ! A temporary array real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -734,7 +732,6 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci if (nTr_stocks > 0) call sum_across_PEs(Tr_stocks,nTr_stocks) call max_across_PEs(max_CFL, 2) - Irho0 = 1.0 / (US%R_to_kg_m3*GV%Rho0) if (CS%use_temperature) then if (CS%previous_calls == 0) then @@ -1031,7 +1028,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) ! enddo ; enddo ; endif if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie - ! convert salt_flux from kg (salt)/(m^2 s) to ppt * [m s-1]. + ! integrate salt_flux in [R Z T-1 ~> kgSalt m-2 s-1] to give [ppt kg] salt_in(i,j) = RZL2_to_kg * dt * & G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index acec868561..cc7cf38e90 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -619,7 +619,7 @@ subroutine tdma6(n, a, c, lam, y) endif yy(k) = y(k) + a(k) * yy(k-1) * I_beta(k-1) enddo - ! The units of y change by a factor of [L2 T-2] in the following lines. + ! The units of y change by a factor of [L2 T-2 ~> m2 s-2] in the following lines. y(n) = yy(n) * I_beta(n) do k = n-1, 1, -1 y(k) = ( yy(k) + c(k) * y(k+1) ) * I_beta(k) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index eb0db68726..286dfa7d95 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -309,13 +309,13 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta ! Local variables real, dimension(GV%ke) :: T0, S0, Pref real :: S_Ref, S_Light, S_Dense ! Salinity range parameters [ppt]. - real :: T_Ref, T_Light, T_Dense ! Temperature range parameters [decC]. + real :: T_Ref, T_Light, T_Dense ! Temperature range parameters [degC]. real :: res_rat ! The ratio of density space resolution in the denser part ! of the range to that in the lighter part of the range. ! Setting this greater than 1 increases the resolution for - ! the denser water. + ! the denser water [nondim]. real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2]. - real :: a1, frac_dense, k_frac + real :: a1, frac_dense, k_frac ! Nondimensional temporary variables [nondim] integer :: k, nz, k_light character(len=40) :: mdl = "set_coord_from_TS_range" ! This subroutine's name. character(len=200) :: filename, coord_file, inputdir ! Strings for file/path diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 069d576b2c..b67d21ebcb 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -144,7 +144,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) endif ! Calculate the value of the Coriolis parameter at the latitude ! -! of the q grid points [s-1]. +! of the q grid points [T-1 ~> s-1]. call MOM_initialize_rotation(G%CoriolisBu, G, PF, US=US) ! Calculate the components of grad f (beta) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) @@ -167,13 +167,13 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed !> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this -!! point the topography is in units of [m], but this can be changed later. +!! point the topography is in units of [Z ~> m] or [m], depending on the presence of US. subroutine MOM_initialize_topography(D, max_depth, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m] + intent(out) :: D !< Ocean bottom depth [Z ~> m] or [m] type(param_file_type), intent(in) :: PF !< Parameter file structure - real, intent(out) :: max_depth !< Maximum depth of model [m] + real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] or [m] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index c252e296a5..838e33b68d 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -184,7 +184,8 @@ end subroutine initialize_topography_from_file subroutine apply_topography_edits_from_file(D, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(inout) :: D !< Ocean bottom depth in m or Z if US is present + intent(inout) :: D !< Ocean bottom depth [m] or [Z ~> m] if + !! US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index dfcd097be0..ce1f9ad92f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1763,10 +1763,10 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading sponge fields real, allocatable, dimension(:,:,:) :: tmp_u,tmp_v ! A temporary array for reading sponge fields - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. - real :: Idamp_u(SZIB_(G),SZJ_(G)) ! The inverse damping rate for velocity fields [T-1 ~> s-1]. - real :: Idamp_v(SZI_(G),SZJB_(G)) ! The inverse damping rate for velocity fields [T-1 ~> s-1]. - real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] + real :: Idamp_u(SZIB_(G),SZJ_(G)) ! The sponge damping rate for velocity fields [T-1 ~> s-1] + real :: Idamp_v(SZI_(G),SZJB_(G)) ! The sponge damping rate for velocity fields [T-1 ~> s-1] + real :: pres(SZI_(G)) ! An array of the reference pressure [R L2 T-2 ~> Pa] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz @@ -1852,7 +1852,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t "of sponge restoring data.", default=time_space_interp_sponge) - ! Read in inverse damping rate for tracers + ! Read in sponge damping rate for tracers filename = trim(inputdir)//trim(damping_file) call log_param(param_file, mdl, "INPUTDIR/SPONGE_DAMPING_FILE", filename) if (.not.file_exists(filename, G%Domain)) & @@ -1863,7 +1863,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t call MOM_read_data(filename, Idamp_var, Idamp(:,:), G%Domain, scale=US%T_to_s) - ! Read in inverse damping rate for velocities + ! Read in sponge damping rate for velocities if (sponge_uv) then if (separate_idamp_for_uv()) then filename = trim(inputdir)//trim(uv_damping_file) @@ -1911,7 +1911,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t 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 - ! Set the inverse damping rates so that the model will know where to + ! Set the sponge damping rates so that the model will know where to ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, param_file, Layer_CSp, GV) deallocate(eta) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index e4f18e75d7..0cf63cced1 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -79,7 +79,8 @@ module MOM_MEKE real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE [nondim] real :: MEKE_topographic_beta !< Weight for how much topographic beta is considered !! when computing beta in Rhines scale [nondim] - real :: MEKE_restoring_rate !< Inverse of the timescale used to nudge MEKE toward its equilibrium value [s-1]. + real :: MEKE_restoring_rate !< Inverse of the timescale used to nudge MEKE toward its + !! equilibrium value [T-1 ~> s-1]. logical :: MEKE_advection_bug !< If true, recover a bug in the calculation of the barotropic !! transport for the advection of MEKE, wherein only the transports in the !! deepest layer are used. diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 5902f98b56..4549601c97 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -682,7 +682,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, d real :: vint_SN(SZIB_(G)) ! Cumulative integral of SN [Z T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G)) :: SN_cpy !< SN at u-points [T-1 ~> s-1] real :: dz_neglect ! An incy wincy distance to avoid division by zero [Z ~> m] - real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~. m-1] + real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~> m-1] real :: dB, dT ! Elevation variables used when cropping [Z ~> m] integer :: i, j, k, l_seg logical :: local_open_u_BC, local_open_v_BC, crop diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index ca545c14ad..eedcf5b547 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -186,9 +186,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! layer; this should be increased due to !! mixed layer entrainment [H ~> m or kg m-2]. type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct - type(optics_type), pointer :: optics !< The structure containing the inverse of the - !! vertical absorption decay scale for - !! penetrating shortwave radiation [m-1]. + type(optics_type), pointer :: optics !< The structure that can be queried for the + !! inverse of the vertical absorption decay + !! scale for penetrating shortwave radiation. real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are @@ -474,9 +474,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Here we add an additional source of TKE to the mixed layer where river ! is present to simulate unresolved estuaries. The TKE input is diagnosed ! as follows: - ! TKE_river[m3 s-3] = 0.5*rivermix_depth*g*Irho0*drho_ds* + ! TKE_river[Z L2 T-3 ~> m3 s-3] = 0.5*rivermix_depth * g * Irho0**2 * drho_ds * ! River*(Samb - Sriver) = CS%mstar*U_star^3 - ! where River is in units of [m s-1]. + ! where River is in units of [R Z T-1 ~> kg m-2 s-1]. ! Samb = Ambient salinity at the mouth of the estuary ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 2cca587e9e..f61f9249ea 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -68,7 +68,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. real :: ustar, absf, htot - real :: energy_Kd ! The energy used by diapycnal mixing [W m-2]. + real :: energy_Kd ! The energy used by diapycnal mixing [R Z L2 T-3 ~> W m-2]. real :: tmp1 ! A temporary array. integer :: i, j, k, is, ie, js, je, nz, itt logical :: may_print diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index e61cc3736b..5dec767f5b 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -552,8 +552,8 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature [R-1 degC-1]. + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific volume + !! with temperature [R-1 degC-1 ~> m3 kg-1 degC-1] real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating !! throughout a layer [R Z3 T-2 ~> J m-2]. @@ -935,7 +935,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) ! This include declares and sets the variable "version". # include "version_variable.h" real :: PenSW_absorb_minthick ! A thickness that is used to absorb the remaining shortwave heat - ! flux when that flux drops below PEN_SW_FLUX_ABSORB [m]. + ! flux when that flux drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2] real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m] logical :: default_2018_answers logical :: use_scheme diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 75fcb04831..f8dcbddadd 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -592,7 +592,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) ! When stratification dominates h_N< kg m-2 or kg m-5] htot = 0.0 ! Calculate the thickness of a stratification limited BBL ignoring rotation: diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b11bb2d8b2..c8166c47b8 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -747,7 +747,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff - real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] + real, parameter :: rho_fw = 1000.0 ! fresh water density [kg m-3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) is = G%isc ; ie = G%iec @@ -1001,7 +1001,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz - N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2] for WKB scaling + N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2 ~> s-2] for WKB scaling TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [Z3 T-3 ~> m3 s-3] TKE_Niku_rem, & ! remaining lee-wave TKE [Z3 T-3 ~> m3 s-3] TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [Z3 T-3 ~> m3 s-3] (BDM) @@ -1578,13 +1578,13 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert real, allocatable, dimension(:) :: & - z_t, & ! depth from surface to midpoint of input layer [Z] - z_w ! depth from surface to top of input layer [Z] + z_t, & ! depth from surface to midpoint of input layer [Z ~> m] + z_w ! depth from surface to top of input layer [Z ~> m] real, allocatable, dimension(:,:,:) :: & - tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] - tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] - tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] - tc_o1 ! input lunar diurnal tidal energy flux [W/m^2] + tc_m2, & ! input lunar semidiurnal tidal energy flux [W m-2] + tc_s2, & ! input solar semidiurnal tidal energy flux [W m-2] + tc_k1, & ! input lunar diurnal tidal energy flux [W m-2] + tc_o1 ! input lunar diurnal tidal energy flux [W m-2] integer, dimension(4) :: nz_in integer :: k, is, ie, js, je, isd, ied, jsd, jed, i, j diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 922ae60fc5..8ef21d190f 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -91,7 +91,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for eta, in depth units [Z ~> m]. - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [T-1 ~> s-1]. + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: H0(SZK_(GV)) ! Resting layer thicknesses in depth units [Z ~> m]. real :: min_depth ! The minimum ocean depth in depth units [Z ~> m]. real :: slat, wlon, lenlat, lenlon, nlat diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 3963d4d90d..6b17d64697 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -29,8 +29,6 @@ module BFB_surface_forcing real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. - real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [Pa]. real :: SST_s !< SST at the southern edge of the linear forcing ramp [degC] real :: SST_n !< SST at the northern edge of the linear forcing ramp [degC] real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degLat] @@ -220,8 +218,6 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "DRHO_DT", CS%drho_dt, & "The rate of change of density with temperature.", & units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R) - call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", default=0.0) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back "//& diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 42279be8e3..70b4bbc27d 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -362,7 +362,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A 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 :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] 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] @@ -418,7 +418,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A call get_param(param_file, mdl, "T_RANGE", T_range, default=0.0) - ! Set the inverse damping rate as a function of position + ! Set the sponge damping rate as a function of position Idamp(:,:) = 0.0 do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0.) then ! Only set damping rate for wet points diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index ee4491799a..b5c14517c2 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -160,7 +160,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) 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 :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1]. real :: H0(SZK_(GV)) ! Interface heights [Z ~> m]. real :: min_depth ! The minimum depth at which to apply damping [Z ~> m] @@ -174,7 +174,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) eta(:,:,:) = 0.0 ; temp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 -! Here the inverse damping time [s-1], is set. Set Idamp to 0 ! +! Here the inverse damping time [T-1 ~> s-1], is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. ! diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 5fe228e278..617ac0da3d 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -440,7 +440,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, 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 :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: TNUDG ! Nudging time scale [T ~> s] real :: S_sur, T_sur ! Surface salinity and temerature in sponge real :: S_bot, T_bot ! Bottom salinity and temerature in sponge @@ -660,7 +660,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! call MOM_mesg(mesg,5) !enddo - ! Set the inverse damping rates so that the model will know where to + ! Set the sponge damping rates so that the model will know where to ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, PF, CSp, GV) ! Apply sponge in tracer fields diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index a2dd76519d..ed7bc07ba3 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -237,7 +237,7 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) 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 :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: eta_im(SZJ_(G),SZK_(GV)+1) ! A temporary array for zonal-mean eta [Z ~> m]. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate [T-1 ~> s-1]. real :: damp_rate ! The inverse zonal-mean damping rate [T-1 ~> s-1]. diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index d051bccc6c..b8eae3c704 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -76,7 +76,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C 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_(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 :: Idamp(SZI_(G),SZJ_(G)) ! The sponge 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 :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for eta, positive upward [m]. @@ -196,7 +196,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C !read eta call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - ! Set the inverse damping rates so that the model will know where to + ! Set the sponge damping rates so that the model will know where to ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, PF, CSp, GV) diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index d719e5867c..18b1fa5225 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -239,7 +239,7 @@ end subroutine write_user_log !! - GV%Rlay - Layer potential density (coordinate variable) [R ~> kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature [degC]. -!! - S - Salinity [psu]. +!! - S - Salinity [ppt]. !! If BULKMIXEDLAYER is defined: !! - Rml - Mixed layer and buffer layer potential densities [R ~> kg m-3]. !! If SPONGE is defined: From 2b0bb9659f7c2b72d546fe832d084eccc29c99fa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Nov 2021 13:28:24 -0500 Subject: [PATCH 065/138] +Add G%Rad_Earth_L and related code simplification Add a dimensionally rescaled variable with the radius of the Earth in [L ~> m] to the ocean_grid_type and dyn_hor_grid type to expand dimensional consistency testing. For now it exists along-side the previous variable with the radius of the Earth in [m], which might be used in other drivers or user code that we are not aware of. All instances in the MOM6 code that were using the unscaled variable G%Rad_Earth were changed to use the dimensionally scaled variable G%Rad_Earth_L. In addition, the code for setting up the grid metrics was simplfied by completing the dimensional rescaling of its internal variables and some grid rescaling factors that were no longer in use were eliminated. As a part of this change, a unit_scale_type argument was added to the interface for USER_initialize_tracer. In addition, a number of comments were changed to clearly distinguish between dimensionally scaled variables that scale back to a nondimensional variable that can take on a range of values (using the syntax [... ~> nondim]), as opposed to variables that are only a combination of dimensional scaling factors that resolve back to 1 in MKS units (using the syntax [... ~> 1]). All answers are bitwise identical, but there is one minor interface change and there are new elements in several widely used transparent types. --- src/core/MOM_checksum_packages.F90 | 2 +- src/core/MOM_grid.F90 | 9 +- src/core/MOM_transcribe_grid.F90 | 6 +- src/diagnostics/MOM_sum_output.F90 | 4 +- src/framework/MOM_dyn_horgrid.F90 | 14 +- src/initialization/MOM_grid_initialize.F90 | 157 ++++++++++-------- .../MOM_shared_initialization.F90 | 84 +++++----- .../vertical/MOM_CVMix_KPP.F90 | 4 +- .../vertical/MOM_diapyc_energy_req.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 4 +- .../vertical/MOM_geothermal.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 14 +- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/tracer_example.F90 | 19 ++- 14 files changed, 165 insertions(+), 158 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index a1c300c94f..be00de8779 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -97,7 +97,7 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully !! symmetric computational domain. - real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> nondim] or [nondim] + real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> 1] or [1] integer :: hs logical :: sym diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 7592dc8477..9c9ebf4960 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -171,10 +171,11 @@ module MOM_grid ! initialization routines (but not all) real :: south_lat !< The latitude (or y-coordinate) of the first v-line real :: west_lon !< The longitude (or x-coordinate) of the first u-line - real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain - real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain - real :: Rad_Earth = 6.378e6 !< The radius of the planet [m]. - real :: max_depth !< The maximum depth of the ocean in depth units [Z ~> m]. + real :: len_lat !< The latitudinal (or y-coord) extent of physical domain + real :: len_lon !< The longitudinal (or x-coord) extent of physical domain + real :: Rad_Earth !< The radius of the planet [m] + real :: Rad_Earth_L !< The radius of the planet in rescaled units [L ~> m] + real :: max_depth !< The maximum depth of the ocean in depth units [Z ~> m] end type ocean_grid_type contains diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index d3447f6590..58063f0669 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -126,7 +126,8 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%areaT_global = dG%areaT_global ; oG%IareaT_global = dG%IareaT_global oG%south_lat = dG%south_lat ; oG%west_lon = dG%west_lon oG%len_lat = dG%len_lat ; oG%len_lon = dG%len_lon - oG%Rad_Earth = dG%Rad_Earth ; oG%max_depth = dG%max_depth + oG%Rad_Earth = dG%Rad_Earth ; oG%Rad_Earth_L = dG%Rad_Earth_L + oG%max_depth = dG%max_depth ! Update the halos in case the dynamic grid has smaller halos than the ocean grid. call pass_var(oG%areaT, oG%Domain) @@ -272,7 +273,8 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%areaT_global = oG%areaT_global ; dG%IareaT_global = oG%IareaT_global dG%south_lat = oG%south_lat ; dG%west_lon = oG%west_lon dG%len_lat = oG%len_lat ; dG%len_lon = oG%len_lon - dG%Rad_Earth = oG%Rad_Earth ; dG%max_depth = oG%max_depth + dG%Rad_Earth = oG%Rad_Earth ; dG%Rad_Earth_L = oG%Rad_Earth_L + dG%max_depth = oG%max_depth ! Update the halos in case the dynamic grid has smaller halos than the ocean grid. call pass_var(dG%areaT, dG%Domain) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 602041372b..4834c83c12 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -390,9 +390,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. real :: HL2_to_kg ! A conversion factor from a thickness-volume to mass [kg H-1 L-2 ~> kg m-3 or 1] real :: KE_scale_factor ! The combination of unit rescaling factors in the kinetic energy - ! calculation [kg T2 H-1 L-2 s-2 ~> kg m-3 or nondim] + ! calculation [kg T2 H-1 L-2 s-2 ~> kg m-3 or 1] real :: PE_scale_factor ! The combination of unit rescaling factors in the potential energy - ! calculation [kg T2 R-1 Z-1 L-2 s-2 ~> nondim] + ! calculation [kg T2 R-1 Z-1 L-2 s-2 ~> 1] integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. integer :: i, j, k, is, ie, js, je, ns, nz, m, Isq, Ieq, Jsq, Jeq, isr, ier, jsr, jer diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index c7db67ee17..b67056cd80 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -163,10 +163,11 @@ module MOM_dyn_horgrid ! initialization routines (but not all) real :: south_lat !< The latitude (or y-coordinate) of the first v-line real :: west_lon !< The longitude (or x-coordinate) of the first u-line - real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain - real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain - real :: Rad_Earth = 6.378e6 !< The radius of the planet [m]. - real :: max_depth !< The maximum depth of the ocean [Z ~> m]. + real :: len_lat !< The latitudinal (or y-coord) extent of physical domain + real :: len_lon !< The longitudinal (or x-coord) extent of physical domain + real :: Rad_Earth !< The radius of the planet [m] + real :: Rad_Earth_L !< The radius of the planet in rescaled units [L ~> m] + real :: max_depth !< The maximum depth of the ocean [Z ~> m] end type dyn_horgrid_type contains @@ -361,6 +362,7 @@ subroutine rotate_dyn_horgrid(G_in, G, US, turns) G%areaT_global = G_in%areaT_global G%IareaT_global = G_in%IareaT_global G%Rad_Earth = G_in%Rad_Earth + G%Rad_Earth_L = G_in%Rad_Earth_L G%max_depth = G_in%max_depth call set_derived_dyn_horgrid(G, US) @@ -406,12 +408,8 @@ subroutine set_derived_dyn_horgrid(G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [L m-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m 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/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 81e7b66d7a..f67a977d27 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -26,14 +26,14 @@ module MOM_grid_initialize ! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Global positioning system (aka container for information to describe the grid) -type, public :: GPS ; private +type, private :: GPS ; private real :: len_lon !< The longitudinal or x-direction length of the domain. real :: len_lat !< The latitudinal or y-direction length of the domain. real :: west_lon !< The western longitude of the domain or the equivalent !! starting value for the x-axis. real :: south_lat !< The southern latitude of the domain or the equivalent !! starting value for the y-axis. - real :: Rad_Earth !< The radius of the Earth [m]. + real :: Rad_Earth_L !< The radius of the Earth in rescaled units [L ~> m] real :: Lat_enhance_factor !< The amount by which the meridional resolution !! is enhanced within LAT_EQ_ENHANCE of the equator. real :: Lat_eq_enhance !< The latitude range to the north and south of the equator @@ -59,12 +59,18 @@ subroutine set_grid_metrics(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + ! Local variables -! This include declares and sets the variable "version". -#include "version_variable.h" + real :: m_to_L ! A length unit conversion factor [L m-1 ~> 1] + real :: L_to_m ! A length unit conversion factor [m L-1 ~> 1] + ! This include declares and sets the variable "version". +# include "version_variable.h" logical :: debug character(len=256) :: config + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m + call callTree_enter("set_grid_metrics(), MOM_grid_initialize.F90") call log_version(param_file, "MOM_grid_init", version, "") call get_param(param_file, "MOM_grid_init", "GRID_CONFIG", config, & @@ -82,6 +88,7 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" + G%Rad_Earth_L = -1.0*m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 select case (trim(config)) case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) @@ -93,6 +100,15 @@ subroutine set_grid_metrics(G, param_file, US) case default ; call MOM_error(FATAL, "MOM_grid_init: set_grid_metrics "//& "Unrecognized grid configuration "//trim(config)) end select + if (G%Rad_Earth_L <= 0.0) then + ! The grid metrics were set with an option that does not explicitly initialize Rad_Earth. + ! ### Rad_Earth should be read as in: + ! call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & + ! "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + ! but for now it is being set via a hard-coded value to reproduce current behavior. + G%Rad_Earth_L = 6.378e6*m_to_L + endif + G%Rad_Earth = L_to_m*G%Rad_Earth_L ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") @@ -113,8 +129,8 @@ subroutine grid_metrics_chksum(parent, G, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] + real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] integer :: halo m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m @@ -181,7 +197,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" type(MOM_domain_type), pointer :: SGdom => NULL() ! Supergrid domain @@ -386,11 +402,10 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) integer :: niglobal, njglobal real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) - real :: dx_everywhere, dy_everywhere ! Grid spacings [m]. - real :: I_dx, I_dy ! Inverse grid spacings [m-1]. + real :: dx_everywhere, dy_everywhere ! Grid spacings [L ~> m]. + real :: I_dx, I_dy ! Inverse grid spacings [L-1 ~> m-1]. real :: PI - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -402,7 +417,6 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & @@ -423,8 +437,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call get_param(param_file, mdl, "LENLON", G%len_lon, & "The longitudinal or x-direction length of the domain.", & units=units_temp, fail_if_missing=.true.) - call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" @@ -462,14 +476,14 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) enddo if (units_temp(1:1) == 'k') then ! Axes are measured in km. - dx_everywhere = 1000.0 * G%len_lon / (REAL(niglobal)) - dy_everywhere = 1000.0 * G%len_lat / (REAL(njglobal)) + dx_everywhere = 1000.0*m_to_L * G%len_lon / (REAL(niglobal)) + dy_everywhere = 1000.0*m_to_L * G%len_lat / (REAL(njglobal)) elseif (units_temp(1:1) == 'm') then ! Axes are measured in m. - dx_everywhere = G%len_lon / (REAL(niglobal)) - dy_everywhere = G%len_lat / (REAL(njglobal)) + dx_everywhere = m_to_L*G%len_lon / (REAL(niglobal)) + dy_everywhere = m_to_L*G%len_lat / (REAL(njglobal)) else ! Axes are measured in degrees of latitude and longitude. - dx_everywhere = G%Rad_Earth * G%len_lon * PI / (180.0 * niglobal) - dy_everywhere = G%Rad_Earth * G%len_lat * PI / (180.0 * njglobal) + dx_everywhere = G%Rad_Earth_L * G%len_lon * PI / (180.0 * niglobal) + dy_everywhere = G%Rad_Earth_L * G%len_lat * PI / (180.0 * njglobal) endif I_dx = 1.0 / dx_everywhere ; I_dy = 1.0 / dy_everywhere @@ -477,30 +491,30 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = grid_lonB(I) ; G%geoLatBu(I,J) = grid_latB(J) - G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = L_to_m*I_dx - G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = L_to_m*I_dy - G%areaBu(I,J) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy + G%dxBu(I,J) = dx_everywhere ; G%IdxBu(I,J) = I_dx + G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy + G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = I_dx * I_dy enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) - G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = L_to_m*I_dx - G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = L_to_m*I_dy - G%areaT(i,j) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy + G%dxT(i,j) = dx_everywhere ; G%IdxT(i,j) = I_dx + G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy + G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = I_dx * I_dy enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) - G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = L_to_m*I_dx - G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = L_to_m*I_dy + G%dxCu(I,j) = dx_everywhere ; G%IdxCu(I,j) = I_dx + G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) - G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = L_to_m*I_dx - G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = L_to_m*I_dy + G%dxCv(i,J) = dx_everywhere ; G%IdxCv(i,J) = I_dx + G%dyCv(i,J) = dy_everywhere ; G%IdyCv(i,J) = I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") @@ -527,7 +541,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -555,8 +569,8 @@ subroutine set_grid_metrics_spherical(G, param_file, US) call get_param(param_file, mdl, "LENLON", G%len_lon, & "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) dLon = G%len_lon/G%Domain%niglobal dLat = G%len_lat/G%Domain%njglobal @@ -600,9 +614,9 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxBu(I,J) = m_to_L*G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di -! G%dxBu(I,J) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) - G%dyBu(I,J) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxBu(I,J) = G%Rad_Earth_L * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di +! G%dxBu(I,J) = G%Rad_Earth_L * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) + G%dyBu(I,J) = G%Rad_Earth_L * dLat*PI_180 G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo @@ -612,9 +626,9 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCv(i,J) = m_to_L*G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di -! G%dxCv(i,J) = m_to_L*G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) - G%dyCv(i,J) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxCv(i,J) = G%Rad_Earth_L * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di +! G%dxCv(i,J) = G%Rad_Earth_L * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) + G%dyCv(i,J) = G%Rad_Earth_L * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -623,9 +637,9 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCu(I,j) = m_to_L*G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di -! G%dxCu(I,j) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyCu(I,j) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxCu(I,j) = G%Rad_Earth_L * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di +! G%dxCu(I,j) = G%Rad_Earth_L * dLon*PI_180 * COS( latitude ) + G%dyCu(I,j) = G%Rad_Earth_L * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -634,13 +648,13 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxT(i,j) = m_to_L*G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di -! G%dxT(i,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyT(i,j) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%dxT(i,j) = G%Rad_Earth_L * COS( G%geoLatT(i,j)*PI_180 ) * dL_di +! G%dxT(i,j) = G%Rad_Earth_L * dLon*PI_180 * COS( latitude ) + G%dyT(i,j) = G%Rad_Earth_L * dLat*PI_180 ! latitude = G%geoLatCv(i,J)*PI_180 ! In radians ! dL_di = G%geoLatCv(i,max(jsd,J-1))*PI_180 ! In radians -! G%areaT(i,j) = m_to_L**2 * Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) +! G%areaT(i,j) = Rad_Earth_L**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) enddo ; enddo @@ -677,7 +691,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is real :: jRef, iRef ! being set to be at grid index jRef or iRef. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] integer :: itt1, itt2 logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -713,11 +727,12 @@ subroutine set_grid_metrics_mercator(G, param_file, US) call get_param(param_file, mdl, "LENLON", GP%len_lon, & "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) G%south_lat = GP%south_lat ; G%len_lat = GP%len_lat G%west_lon = GP%west_lon ; G%len_lon = GP%len_lon - G%Rad_Earth = GP%Rad_Earth + G%Rad_Earth_L = GP%Rad_Earth_L + call get_param(param_file, mdl, "ISOTROPIC", GP%isotropic, & "If true, an isotropic grid on a sphere (also known as "//& "a Mercator grid) is used. With an isotropic grid, the "//& @@ -826,8 +841,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = xq(I,J)*180.0/PI G%geoLatBu(I,J) = yq(I,J)*180.0/PI - G%dxBu(I,J) = m_to_L*ds_di(xq(I,J), yq(I,J), GP) - G%dyBu(I,J) = m_to_L*ds_dj(xq(I,J), yq(I,J), GP) + G%dxBu(I,J) = ds_di(xq(I,J), yq(I,J), GP) + G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) @@ -836,8 +851,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = xh(i,j)*180.0/PI G%geoLatT(i,j) = yh(i,j)*180.0/PI - G%dxT(i,j) = m_to_L*ds_di(xh(i,j), yh(i,j), GP) - G%dyT(i,j) = m_to_L*ds_dj(xh(i,j), yh(i,j), GP) + G%dxT(i,j) = ds_di(xh(i,j), yh(i,j), GP) + G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) @@ -846,20 +861,20 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = xu(I,j)*180.0/PI G%geoLatCu(I,j) = yu(I,j)*180.0/PI - G%dxCu(I,j) = m_to_L*ds_di(xu(I,j), yu(I,j), GP) - G%dyCu(I,j) = m_to_L*ds_dj(xu(I,j), yu(I,j), GP) + G%dxCu(I,j) = ds_di(xu(I,j), yu(I,j), GP) + G%dyCu(I,j) = ds_dj(xu(I,j), yu(I,j), GP) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = xv(i,J)*180.0/PI G%geoLatCv(i,J) = yv(i,J)*180.0/PI - G%dxCv(i,J) = m_to_L*ds_di(xv(i,J), yv(i,J), GP) - G%dyCv(i,J) = m_to_L*ds_dj(xv(i,J), yv(i,J), GP) + G%dxCv(i,J) = ds_di(xv(i,J), yv(i,J), GP) + G%dyCv(i,J) = ds_dj(xv(i,J), yv(i,J), GP) enddo ; enddo if (.not.simple_area) then do j=JsdB+1,jed ; do i=IsdB+1,ied - G%areaT(I,J) = m_to_L**2*GP%Rad_Earth**2 * & + G%areaT(I,J) = GP%Rad_Earth_L**2 * & (dL(xq(I-1,J-1),xq(I-1,J),yq(I-1,J-1),yq(I-1,J)) + & (dL(xq(I-1,J),xq(I,J),yq(I-1,J),yq(I,J)) + & (dL(xq(I,J),xq(I,J-1),yq(I,J),yq(I,J-1)) + & @@ -884,31 +899,31 @@ subroutine set_grid_metrics_mercator(G, param_file, US) end subroutine set_grid_metrics_mercator -!> This function returns the grid spacing in the logical x direction. +!> This function returns the grid spacing in the logical x direction in [L ~> m]. function ds_di(x, y, GP) real, intent(in) :: x !< The longitude in question real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: ds_di - ! Local variables - ds_di = GP%Rad_Earth * cos(y) * dx_di(x,GP) + real :: ds_di ! The returned grid spacing [L ~> m] + + ds_di = GP%Rad_Earth_L * cos(y) * dx_di(x,GP) ! In general, this might be... - ! ds_di = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + & + ! ds_di = GP%Rad_Earth_L * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + & ! dy_di(x,y,GP)*dy_di(x,y,GP)) end function ds_di -!> This function returns the grid spacing in the logical y direction. +!> This function returns the grid spacing in the logical y direction in [L ~> m]. function ds_dj(x, y, GP) real, intent(in) :: x !< The longitude in question real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters - ! Local variables - real :: ds_dj - ds_dj = GP%Rad_Earth * dy_dj(y,GP) + real :: ds_dj ! The returned grid spacing [L ~> m] + + ds_dj = GP%Rad_Earth_L * dy_dj(y,GP) ! In general, this might be... - ! ds_dj = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + & + ! ds_dj = GP%Rad_Earth_L * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + & ! dy_dj(x,y,GP)*dy_dj(x,y,GP)) end function ds_dj @@ -1199,8 +1214,7 @@ subroutine initialize_masks(G, PF, US) type(param_file_type), intent(in) :: PF !< Parameter file structure type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z_scale ! A unit conversion factor from m to Z. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: m_to_Z_scale ! A unit conversion factor from m to Z [Z m-1 ~> 1] real :: Dmask ! The depth for masking in the same units as G%bathyT [Z ~> m]. real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. @@ -1209,7 +1223,6 @@ subroutine initialize_masks(G, PF, US) call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index c252e296a5..0fb2b59fc4 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -95,7 +95,7 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] real :: f1, f2 m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L @@ -298,13 +298,13 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! This subroutine places the bottom depth in m into D(:,:), shaped according to the named config. ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. + real :: m_to_Z ! A dimensional rescaling factor [Z m-1 ~> 1] + real :: m_to_L ! A dimensional rescaling factor [L m-1 ~> 1] real :: min_depth ! The minimum depth [Z ~> m]. real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH. - real :: expdecay ! A decay scale of associated with the sloping boundaries [m]. - real :: Dedge ! The depth [Z ~> m], at the basin edge -! real :: south_lat, west_lon, len_lon, len_lat, Rad_earth + real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] + real :: expdecay ! A decay scale of associated with the sloping boundaries [L ~> m] + real :: Dedge ! The depth at the basin edge [Z ~> m] integer :: i, j, is, ie, js, je, isd, ied, jsd, jed character(len=40) :: mdl = "initialize_topography_named" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -315,6 +315,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth "TOPO_CONFIG = "//trim(topog_config), 5) m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) @@ -325,23 +326,9 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth call get_param(param_file, mdl, "EDGE_DEPTH", Dedge, & "The depth at the edge of one of the named topographies.", & units="m", default=100.0, scale=m_to_Z) -! call get_param(param_file, mdl, "SOUTHLAT", south_lat, & -! "The southern latitude of the domain.", units="degrees", & -! fail_if_missing=.true.) -! call get_param(param_file, mdl, "LENLAT", len_lat, & -! "The latitudinal length of the domain.", units="degrees", & -! fail_if_missing=.true.) -! call get_param(param_file, mdl, "WESTLON", west_lon, & -! "The western longitude of the domain.", units="degrees", & -! default=0.0) -! call get_param(param_file, mdl, "LENLON", len_lon, & -! "The longitudinal length of the domain.", units="degrees", & -! fail_if_missing=.true.) -! call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth, & -! "The radius of the Earth.", units="m", default=6.378e6) call get_param(param_file, mdl, "TOPOG_SLOPE_SCALE", expdecay, & "The exponential decay scale used in defining some of "//& - "the named topographies.", units="m", default=400000.0) + "the named topographies.", units="m", default=400000.0, scale=m_to_L) endif @@ -351,30 +338,30 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth do i=is,ie ; do j=js,je ; D(i,j) = max_depth ; enddo ; enddo elseif (trim(topog_config) == "spoon") then D0 = (max_depth - Dedge) / & - ((1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay))) * & - (1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay)))) + ((1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay))) * & + (1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay)))) do i=is,ie ; do j=js,je ! This sets a bowl shaped (sort of) bottom topography, with a ! ! maximum depth of max_depth. ! D(i,j) = Dedge + D0 * & (sin(PI * (G%geoLonT(i,j) - (G%west_lon)) / G%len_lon) * & - (1.0 - exp((G%geoLatT(i,j) - (G%south_lat+G%len_lat))*G%Rad_earth*PI / & + (1.0 - exp((G%geoLatT(i,j) - (G%south_lat+G%len_lat))*G%Rad_Earth_L*PI / & (180.0*expdecay)) )) enddo ; enddo elseif (trim(topog_config) == "bowl") then D0 = (max_depth - Dedge) / & - ((1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay))) * & - (1.0 - exp(-0.5*G%len_lat*G%Rad_earth*PI/(180.0 *expdecay)))) + ((1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay))) * & + (1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay)))) ! This sets a bowl shaped (sort of) bottom topography, with a ! maximum depth of max_depth. do i=is,ie ; do j=js,je D(i,j) = Dedge + D0 * & (sin(PI * (G%geoLonT(i,j) - G%west_lon) / G%len_lon) * & - ((1.0 - exp(-(G%geoLatT(i,j) - G%south_lat)*G%Rad_Earth*PI/ & + ((1.0 - exp(-(G%geoLatT(i,j) - G%south_lat)*G%Rad_Earth_L*PI/ & (180.0*expdecay))) * & (1.0 - exp((G%geoLatT(i,j) - (G%south_lat+G%len_lat))* & - G%Rad_Earth*PI/(180.0*expdecay))))) + G%Rad_Earth_L*PI/(180.0*expdecay))))) enddo ; enddo elseif (trim(topog_config) == "halfpipe") then D0 = max_depth - Dedge @@ -510,10 +497,13 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1] - real :: beta ! The meridional gradient of the Coriolis parameter [T-1 m-1 ~> s-1 m-1] - real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] - real :: y_scl, Rad_Earth - real :: T_to_s ! A time unit conversion factor + real :: beta ! The meridional gradient of the Coriolis parameter [T-1 L-1 ~> s-1 m-1] + real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] + real :: Rad_Earth_L ! The radius of the planet in rescaled units [L ~> m] + real :: y_scl ! A scaling factor from the units of latitude [L lat-1 ~> m lat-1] + real :: T_to_s ! A time unit conversion factor [s T-1 ~> 1] + real :: m_to_L ! A length unit conversion factor [L m-1 ~> 1] + real :: L_to_m ! A length unit conversion factor [m L-1 ~> 1] real :: PI character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units @@ -522,28 +512,30 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "F_0", f_0, & "The reference value of the Coriolis parameter with the "//& "betaplane option.", units="s-1", default=0.0, scale=T_to_s) call get_param(param_file, mdl, "BETA", beta, & "The northward gradient of the Coriolis parameter with "//& - "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s) + "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s*L_to_m) call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") PI = 4.0*atan(1.0) select case (axis_units(1:1)) case ("d") - call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth, & - "The radius of the Earth.", units="m", default=6.378e6) + call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth_L, & + "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) beta_lat_ref_units = "degrees" - y_scl = PI * Rad_Earth/ 180. + y_scl = PI * Rad_Earth_L / 180. case ("k") beta_lat_ref_units = "kilometers" - y_scl = 1.E3 + y_scl = 1.E3 * m_to_L case ("m") beta_lat_ref_units = "meters" - y_scl = 1. + y_scl = 1. * m_to_L case default ; call MOM_error(FATAL, & " set_rotation_beta_plane: unknown AXIS_UNITS = "//trim(axis_units)) end select @@ -644,8 +636,8 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] + real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] real :: dx_2 = -1.0, dy_2 = -1.0 real :: pi_180 integer :: option = -1 @@ -772,8 +764,8 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] + real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -850,8 +842,8 @@ subroutine reset_face_lengths_list(G, param_file, US) integer, allocatable, dimension(:) :: & u_line_no, v_line_no, & ! The line numbers in lines of u- and v-face lines u_line_used, v_line_used ! The number of times each u- and v-line is used. - real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] - real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] + real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] + real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -1022,7 +1014,7 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(L_to_m*G%dyCu(I,j), max(u_width(npt), 0.0)) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(m_to_L*u_width(npt), 0.0)) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then write(stdout,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -1052,7 +1044,7 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(L_to_m*G%dxCv(i,J), max(v_width(npt), 0.0)) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(m_to_L*v_width(npt), 0.0)) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(stdout,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index b9ceb85cc5..5342c621dd 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -641,7 +641,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & real :: surfFricVel, surfBuoyFlux real :: sigma, sigmaRatio - real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] real :: dh ! The local thickness used for calculating interface positions [m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] @@ -948,7 +948,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average [m] - real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] real :: delH ! Thickness of a layer [m] real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 2cca587e9e..96c9abc84e 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -1193,7 +1193,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: b1Kd ! Temporary array [nondim] real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. - real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> 1 or m3 kg-1]. + real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1] real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 4a762cd34c..d05423ed94 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -636,7 +636,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: LA ! The value of the Langmuir number [nondim] real :: LAmod ! The modified Langmuir number by convection [nondim] real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. + ! conversion factor from H to Z [Z H-1 ~> nondim or m3 kg-1]. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing [nondim]. between 0 and 1. @@ -1634,7 +1634,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: b1Kd ! Temporary array [nondim] real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. - real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> 1 or m3 kg-1]. + real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1] real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [degC] real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [ppt] real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 7fdaa6abda..9bcdbd46bf 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -502,7 +502,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith ! Local variables character(len=200) :: inputdir, geo_file, filename, geotherm_var real :: geo_scale ! A constant heat flux or dimensionally rescaled geothermal flux scaling factor - ! [Q R Z T-1 ~> W m-2] or [Q R Z m2 s J-1 T-1 ~> 1] + ! [Q R Z T-1 ~> W m-2] or [Q R Z m2 s J-1 T-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed, id isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 75fcb04831..7fc67dbbec 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -177,7 +177,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H R ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> nondim]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -256,7 +256,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) real :: Cell_width ! The transverse width of the velocity cell [L ~> m]. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's ! velocity magnitude to give the Rayleigh drag velocity, times - ! a lateral to vertical distance conversion factor [Z L-1 ~> 1]. + ! a lateral to vertical distance conversion factor [Z L-1 ~> nondim]. real :: gam ! The ratio of the change in the open interface width ! to the open interface width atop a cell [nondim]. real :: BBL_frac ! The fraction of a layer's drag that goes into the @@ -947,10 +947,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) ! set kv_bbl to the bound and recompute bbl_thick to be consistent ! but with a ridiculously large upper bound on thickness (for Cd u*=0) kv_bbl = CS%Kv_BBL_min - if (cdrag_sqrt*ustar(i)*BBL_visc_frac*G%Rad_Earth*US%m_to_Z > kv_bbl) then + if (cdrag_sqrt*ustar(i)*BBL_visc_frac*G%Rad_Earth_L*US%L_to_Z > kv_bbl) then bbl_thick_Z = kv_bbl / ( cdrag_sqrt*ustar(i)*BBL_visc_frac ) else - bbl_thick_Z = G%Rad_Earth * US%m_to_Z + bbl_thick_Z = G%Rad_Earth_L * US%L_to_Z endif else kv_bbl = cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac @@ -979,10 +979,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS) ! set kv_bbl to the bound and recompute bbl_thick to be consistent ! but with a ridiculously large upper bound on thickness (for Cd u*=0) kv_bbl = CS%Kv_BBL_min - if (cdrag_sqrt*ustar(i)*G%Rad_Earth*US%m_to_Z > kv_bbl) then + if (cdrag_sqrt*ustar(i)*G%Rad_Earth_L*US%L_to_Z > kv_bbl) then bbl_thick_Z = kv_bbl / ( cdrag_sqrt*ustar(i) ) else - bbl_thick_Z = G%Rad_Earth * US%m_to_Z + bbl_thick_Z = G%Rad_Earth_L * US%L_to_Z endif else kv_bbl = cdrag_sqrt*ustar(i)*bbl_thick_Z @@ -1214,7 +1214,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H R ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> nondim] real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index a44750c1fc..4278594913 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -310,7 +310,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag ! Add other user-provided calls here. if (CS%use_USER_tracer_example) & - call USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS%USER_tracer_example_CSp, & + call USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS%USER_tracer_example_CSp, & sponge_CSp) if (CS%use_DOME_tracer) & call initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS%DOME_tracer_CSp, & diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index b58e45b366..10551ea247 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -134,13 +134,14 @@ end function USER_register_tracer_example !> This subroutine initializes the NTR tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. -subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp) 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. 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(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -163,7 +164,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, pointer :: tr_ptr(:,:,:) => NULL() real :: PI ! 3.1415926... calculated as 4*atan(1) real :: tr_y ! Initial zonally uniform tracer concentrations. - real :: dist2 ! The distance squared from a line [m2]. + real :: dist2 ! The distance squared from a line [L2 ~> m2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB, lntr @@ -196,9 +197,9 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! This sets a stripe of tracer across the basin. PI = 4.0*atan(1.0) do j=js,je - dist2 = (G%Rad_Earth * PI / 180.0)**2 * & + dist2 = (G%Rad_Earth_L * PI / 180.0)**2 * & (G%geoLatT(i,j) - 40.0) * (G%geoLatT(i,j) - 40.0) - tr_y = 0.5*exp(-dist2/(1.0e5*1.0e5)) + tr_y = 0.5 * exp( -dist2 / (1.0e5*US%m_to_L)**2 ) do k=1,nz ; do i=is,ie ! This adds the stripes of tracer to every layer. @@ -282,10 +283,10 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, ! Local variables 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_(GV)) ! tridiagonal solver. - real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver. + ! with surface mass fluxes added back [H ~> m or kg m-2]. + real :: b1(SZI_(G)) ! b1 is a variable used by the tridiagonal solver [H ~> m or kg m-2]. + real :: c1(SZI_(G),SZK_(GV)) ! c1 is a variable used by the tridiagonal solver [nondim]. + real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. @@ -374,7 +375,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) !! stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] 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 From e717e46ee6593b4460db68b56938d62bd4ec05ec Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Wed, 24 Nov 2021 14:57:34 -0500 Subject: [PATCH 066/138] preserve dimensions in porous topo interpolation * changed porous topo code to preserve dimensions * readded rotations that got lost in merge --- src/core/MOM_porous_barriers.F90 | 67 ++++++++++++++++--------------- src/framework/MOM_dyn_horgrid.F90 | 8 ++++ 2 files changed, 43 insertions(+), 32 deletions(-) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index 1230b47cfb..34af04a7e4 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -50,8 +50,8 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) !local variables integer ii, i, j, k, nk, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB real w_layer, & ! fractional open width of layer interface [nondim] - A_layer, & ! integral of fractional open width from bottom to current layer[nondim] - A_layer_prev, & ! integral of fractional open width from bottom to previous layer [nondim] + A_layer, & ! integral of fractional open width from bottom to current layer[Z ~> m] + A_layer_prev, & ! integral of fractional open width from bottom to previous layer [Z ~> m] eta_s, & ! layer height used for fit [Z ~> m] eta_prev ! interface height of previous layer [Z ~> m] isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed @@ -67,22 +67,20 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) do j=jsd,jed; do I=IsdB,IedB if (G%porous_DavgU(I,j) < 0.) then do K = nk+1,1,-1 - eta_s = max(US%Z_to_m*eta(I,j,K), US%Z_to_m*eta(I+1,j,K)) !take shallower layer height - !eta_s = 0.5 * (US%Z_to_m*eta(I,j,K) + US%Z_to_m*eta(I+1,j,K)) !take arithmetic mean - if (eta_s <= G%porous_DminU(I,j)) then + eta_s = max(eta(I,j,K), eta(I+1,j,K)) !take shallower layer height + if (US%Z_to_m*eta_s <= (US%Z_to_m*G%porous_DminU(I,j))) then pbv%por_layer_widthU(I,j,K) = 0.0 A_layer_prev = 0.0 if (K < nk+1) then pbv%por_face_areaU(I,j,k) = 0.0; endif else - call calc_por_layer(US%Z_to_m*(G%porous_DminU(I,j)-G%Z_ref), & - US%Z_to_m*(G%porous_DmaxU(I,j)-G%Z_ref), & - US%Z_to_m*(G%porous_DavgU(I,j)-G%Z_ref), eta_s, w_layer, A_layer) + call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), & + G%porous_DavgU(I,j), eta_s, w_layer, A_layer, G%Z_ref, US%Z_to_m) pbv%por_layer_widthU(I,j,K) = w_layer if (k <= nk) then if ((eta_s - eta_prev) > 0.0) then pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev)/& - (eta_s-eta_prev) + (US%Z_to_m*(eta_s-eta_prev)) else pbv%por_face_areaU(I,j,k) = 0.0; endif endif @@ -96,22 +94,20 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) do i=isd,ied; do J=JsdB,JedB if (G%porous_DavgV(i,J) < 0.) then do K = nk+1,1,-1 - eta_s = max(US%Z_to_m*eta(i,J,K), US%Z_to_m*eta(i,J+1,K)) !take shallower layer height - !eta_s = 0.5 * (US%Z_to_m*eta(i,J,K) + US%Z_to_m*eta(i,J+1,K)) !take arithmetic mean - if (eta_s <= G%porous_DminV(i,J)) then + eta_s = max(eta(i,J,K), eta(i,J+1,K)) !take shallower layer height + if (US%Z_to_m*eta_s <= US%Z_to_m*G%porous_DminV(i,J)) then pbv%por_layer_widthV(i,J,K) = 0.0 A_layer_prev = 0.0 if (K < nk+1) then pbv%por_face_areaV(i,J,k) = 0.0; endif else - call calc_por_layer(US%Z_to_m*(G%porous_DminV(i,J)-G%Z_ref), & - US%Z_to_m*(G%porous_DmaxV(i,J)-G%Z_ref), & - US%Z_to_m*(G%porous_DavgV(i,J)-G%Z_ref), eta_s, w_layer, A_layer) + call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), & + G%porous_DavgV(i,J), eta_s, w_layer, A_layer, G%Z_ref, US%Z_to_m) pbv%por_layer_widthV(i,J,K) = w_layer if (k <= nk) then if ((eta_s - eta_prev) > 0.0) then pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev)/& - (eta_s-eta_prev) + (US%Z_to_m*(eta_s-eta_prev)) else pbv%por_face_areaU(I,j,k) = 0.0; endif endif @@ -125,32 +121,39 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) end subroutine por_widths !> subroutine to calculate the profile fit for a single layer in a column -subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) +subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer, Z_ref, Z_to_m) - real, intent(in) :: D_min !< minimum topographic height [m] - real, intent(in) :: D_max !< maximum topographic height [m] - real, intent(in) :: D_avg !< mean topographic height [m] - real, intent(in) :: eta_layer !< height of interface [m] + real, intent(in) :: D_min !< minimum topographic height [Z ~> m] + real, intent(in) :: D_max !< maximum topographic height [Z ~> m] + real, intent(in) :: D_avg !< mean topographic height [Z ~> m] + real, intent(in) :: eta_layer !< height of interface [Z ~> m] real, intent(out) :: w_layer !< frac. open interface width of current layer [nondim] - real, intent(out) :: A_layer !< frac. open face area of current layer [nondim] + real, intent(out) :: A_layer !< frac. open face area of current layer [Z ~> m] + real, intent(in) :: Z_ref !< reference value for geometric height fields [Z ~> m] + real, intent(in) :: Z_to_m !< a unit conversion factor from units of Z to m !local variables - real m, a, & !convenience constant for fit [nondim] - zeta, & !normalized vertical coordinate [nondim] - psi, & !fractional width of layer between Dmin and Dmax [nondim] - psi_int !integral of psi from 0 to zeta + real Dmin, Dmax, Davg, & !copies of input topographic heights stored in [m] + etam, & !copy of eta_layer stored in [m] + m, a, & !convenience constant for fit [nondim] + zeta, & !normalized vertical coordinate [nondim] + psi, & !fractional width of layer between Dmin and Dmax [nondim] + psi_int !integral of psi from 0 to zeta + + Dmin = Z_to_m*(D_min - Z_ref); Dmax = Z_to_m*(D_max - Z_ref) + Davg = Z_to_m*(D_avg - Z_ref); etam = Z_to_m*(eta_layer - Z_ref) !three parameter fit from Adcroft 2013 - m = (D_avg - D_min)/(D_max - D_min) + m = (Davg - Dmin)/(Dmax - Dmin) a = (1. - m)/m - zeta = (eta_layer - D_min)/(D_max - D_min) + zeta = (etam - Dmin)/(Dmax - Dmin) - if (eta_layer <= D_min) then + if (etam <= Dmin) then w_layer = 0.0 A_layer = 0.0 - elseif (eta_layer >= D_max) then + elseif (etam >= Dmax) then w_layer = 1.0 - A_layer = eta_layer - D_avg + A_layer = etam - Davg else if (m < 0.5) then psi = zeta**(1./a) @@ -163,7 +166,7 @@ subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) psi_int = zeta - m + m*((1-zeta)**(1/m)) endif w_layer = psi - A_layer = (D_max - D_min)*psi_int + A_layer = (Dmax - Dmin)*psi_int endif diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index efa3b02b2b..5b4f34a87e 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -336,6 +336,14 @@ subroutine rotate_dyn_horgrid(G_in, G, US, turns) call rotate_array_pair(G_in%areaCu, G_in%areaCv, turns, G%areaCu, G%areaCv) call rotate_array_pair(G_in%IareaCu, G_in%IareaCv, turns, G%IareaCu, G%IareaCv) + call rotate_array_pair(G_in%porous_DminU, G_in%porous_DminV, & + turns, G%porous_DminU, G%porous_DminV) + call rotate_array_pair(G_in%porous_DmaxU, G_in%porous_DmaxV, & + turns, G%porous_DmaxU, G%porous_DmaxV) + call rotate_array_pair(G_in%porous_DavgU, G_in%porous_DavgV, & + turns, G%porous_DavgU, G%porous_DavgV) + + ! Vertex point call rotate_array(G_in%geoLonBu, turns, G%geoLonBu) call rotate_array(G_in%geoLatBu, turns, G%geoLatBu) From 04d932e271741dd05a4045c1acae6da9ece514a9 Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Wed, 24 Nov 2021 17:35:16 -0500 Subject: [PATCH 067/138] Remove Z_to_m rescaling in porous module --- src/core/MOM_porous_barriers.F90 | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index 34af04a7e4..cdaf566342 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -68,14 +68,14 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) if (G%porous_DavgU(I,j) < 0.) then do K = nk+1,1,-1 eta_s = max(eta(I,j,K), eta(I+1,j,K)) !take shallower layer height - if (US%Z_to_m*eta_s <= (US%Z_to_m*G%porous_DminU(I,j))) then + if (eta_s <= G%porous_DminU(I,j)) then pbv%por_layer_widthU(I,j,K) = 0.0 A_layer_prev = 0.0 if (K < nk+1) then pbv%por_face_areaU(I,j,k) = 0.0; endif else call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), & - G%porous_DavgU(I,j), eta_s, w_layer, A_layer, G%Z_ref, US%Z_to_m) + G%porous_DavgU(I,j), eta_s, w_layer, A_layer) pbv%por_layer_widthU(I,j,K) = w_layer if (k <= nk) then if ((eta_s - eta_prev) > 0.0) then @@ -95,14 +95,14 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) if (G%porous_DavgV(i,J) < 0.) then do K = nk+1,1,-1 eta_s = max(eta(i,J,K), eta(i,J+1,K)) !take shallower layer height - if (US%Z_to_m*eta_s <= US%Z_to_m*G%porous_DminV(i,J)) then + if (eta_s <= G%porous_DminV(i,J)) then pbv%por_layer_widthV(i,J,K) = 0.0 A_layer_prev = 0.0 if (K < nk+1) then pbv%por_face_areaV(i,J,k) = 0.0; endif else call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), & - G%porous_DavgV(i,J), eta_s, w_layer, A_layer, G%Z_ref, US%Z_to_m) + G%porous_DavgV(i,J), eta_s, w_layer, A_layer) pbv%por_layer_widthV(i,J,K) = w_layer if (k <= nk) then if ((eta_s - eta_prev) > 0.0) then @@ -129,19 +129,12 @@ subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer, Z_re real, intent(in) :: eta_layer !< height of interface [Z ~> m] real, intent(out) :: w_layer !< frac. open interface width of current layer [nondim] real, intent(out) :: A_layer !< frac. open face area of current layer [Z ~> m] - real, intent(in) :: Z_ref !< reference value for geometric height fields [Z ~> m] - real, intent(in) :: Z_to_m !< a unit conversion factor from units of Z to m !local variables - real Dmin, Dmax, Davg, & !copies of input topographic heights stored in [m] - etam, & !copy of eta_layer stored in [m] - m, a, & !convenience constant for fit [nondim] + real m, a, & !convenience constant for fit [nondim] zeta, & !normalized vertical coordinate [nondim] psi, & !fractional width of layer between Dmin and Dmax [nondim] psi_int !integral of psi from 0 to zeta - Dmin = Z_to_m*(D_min - Z_ref); Dmax = Z_to_m*(D_max - Z_ref) - Davg = Z_to_m*(D_avg - Z_ref); etam = Z_to_m*(eta_layer - Z_ref) - !three parameter fit from Adcroft 2013 m = (Davg - Dmin)/(Dmax - Dmin) a = (1. - m)/m From a98c3ef0d85d02b0e053d494e82fbabfebc7c559 Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Wed, 24 Nov 2021 17:39:55 -0500 Subject: [PATCH 068/138] small bug fix --- src/core/MOM_porous_barriers.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index cdaf566342..f3444e6476 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -121,7 +121,7 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) end subroutine por_widths !> subroutine to calculate the profile fit for a single layer in a column -subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer, Z_ref, Z_to_m) +subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) real, intent(in) :: D_min !< minimum topographic height [Z ~> m] real, intent(in) :: D_max !< maximum topographic height [Z ~> m] From 66e1493affbf24ca2334f6b0de448801501c11f1 Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Wed, 24 Nov 2021 17:41:46 -0500 Subject: [PATCH 069/138] small bug fix 2 --- src/core/MOM_porous_barriers.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index f3444e6476..4f4fd087bb 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -80,7 +80,7 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) if (k <= nk) then if ((eta_s - eta_prev) > 0.0) then pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev)/& - (US%Z_to_m*(eta_s-eta_prev)) + (eta_s-eta_prev) else pbv%por_face_areaU(I,j,k) = 0.0; endif endif @@ -107,7 +107,7 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) if (k <= nk) then if ((eta_s - eta_prev) > 0.0) then pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev)/& - (US%Z_to_m*(eta_s-eta_prev)) + (eta_s-eta_prev) else pbv%por_face_areaU(I,j,k) = 0.0; endif endif From 62786c40014da8463afb35421dc7315815624184 Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Wed, 24 Nov 2021 18:22:16 -0500 Subject: [PATCH 070/138] fix merge issue --- src/core/MOM_porous_barriers.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index 4f4fd087bb..b20fb993e0 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -132,21 +132,21 @@ subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) !local variables real m, a, & !convenience constant for fit [nondim] zeta, & !normalized vertical coordinate [nondim] - psi, & !fractional width of layer between Dmin and Dmax [nondim] + psi, & !fractional width of layer between D_min and D_max [nondim] psi_int !integral of psi from 0 to zeta !three parameter fit from Adcroft 2013 - m = (Davg - Dmin)/(Dmax - Dmin) + m = (D_avg - D_min)/(D_max - D_min) a = (1. - m)/m - zeta = (etam - Dmin)/(Dmax - Dmin) + zeta = (eta_layer - D_min)/(D_max - D_min) - if (etam <= Dmin) then + if (eta_layer <= D_min) then w_layer = 0.0 A_layer = 0.0 - elseif (etam >= Dmax) then + elseif (eta_layer >= D_max) then w_layer = 1.0 - A_layer = etam - Davg + A_layer = eta_layer - D_avg else if (m < 0.5) then psi = zeta**(1./a) @@ -159,7 +159,7 @@ subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) psi_int = zeta - m + m*((1-zeta)**(1/m)) endif w_layer = psi - A_layer = (Dmax - Dmin)*psi_int + A_layer = (D_max - D_min)*psi_int endif From 2a82bbdc3fe76d0cc7e829a00c1044142b17cc50 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Nov 2021 13:41:28 -0500 Subject: [PATCH 071/138] (*)Fix rescaling when SPLIT_BOTTOM_STRESS = True Corrected the dimensional rescaling of the explicit bottom stresses that are passed to btstep() when SPLIT_BOTTOM_STRESS = True. Without this correction, solutions would not pass the dimensional consistency tests in this case. Thankfully, the parameter setting in question does not seem to be widely used, and even if it is, answers will not change when Z_RESCALE_POWER = 0. All answers and output in the MOM6-examples test suite are bitwise identical. --- src/core/MOM_barotropic.F90 | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index c2ca1be16e..ca1a7d20e5 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -338,9 +338,9 @@ module MOM_barotropic !! the time-integrated barotropic velocity [L ~> m], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: uh_WW !< The zonal transport when ubt=ubt_WW [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent !! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg]. real :: uh_EE !< The zonal transport when ubt=ubt_EE [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent @@ -364,9 +364,9 @@ module MOM_barotropic !! the time-integrated barotropic velocity [L ~> m], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: vh_crvN !< The curvature of face area with velocity for flow from the north [H T2 L-1 ~> s2 or kg s2 m-3] - !! or [H L-1 ~> 1 or kg m-3] with INTEGRAL_BT_CONTINUITY. + !! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY. real :: vh_SS !< The meridional transport when vbt=vbt_SS [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent !! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg]. real :: vh_NN !< The meridional transport when vbt=vbt_NN [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent @@ -622,24 +622,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vhbt_prev, vhbt_sum_prev, & ! Previous transports stored for OBCs [L2 H T-1 ~> m3 s-1] vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m] vhbt_int_prev ! Previous value of time-integrated transport stored for OBCs [L2 H ~> m3] - real :: mass_to_Z ! The depth unit conversion divided by the mean density (Rho0) [Z m-1 R-1 ~> m3 kg-1] !### R-1 - real :: mass_accel_to_Z ! The inverse of the mean density (Rho0) [R-1 ~> m3 kg-1]. - real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. + real :: mass_to_Z ! The inverse of the the mean density (Rho0) [R-1 ~> m3 kg-1] + real :: visc_rem ! A work variable that may equal visc_rem_[uv] [nondim] real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: dtbt ! The barotropic time step [T ~> s]. real :: bebt ! A copy of CS%bebt [nondim]. real :: be_proj ! The fractional amount by which velocities are projected - ! when project_velocity is true. For now be_proj is set + ! when project_velocity is true [nondim]. For now be_proj is set ! to equal bebt, as they have similar roles and meanings. real :: Idt ! The inverse of dt [T-1 ~> s-1]. real :: det_de ! The partial derivative due to self-attraction and loading - ! of the reference geopotential with the sea surface height. + ! of the reference geopotential with the sea surface height [nondim]. ! This is typically ~0.09 or less. real :: dgeo_de ! The constant of proportionality between geopotential and - ! sea surface height. It is a nondimensional number of + ! sea surface height [nondim]. It is a nondimensional number of ! order 1. For stability, this may be made larger ! than the physical problem would suggest. - real :: Instep ! The inverse of the number of barotropic time steps to take. + real :: Instep ! The inverse of the number of barotropic time steps to take [nondim]. real :: wt_end ! The weighting of the final value of eta_PF [nondim] integer :: nstep ! The number of barotropic time steps to take. type(time_type) :: & @@ -772,8 +771,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Idtbt = 1.0 / dtbt bebt = CS%bebt be_proj = CS%bebt - mass_accel_to_Z = 1.0 / GV%Rho0 - mass_to_Z = US%m_to_Z / GV%Rho0 !### THis should be the same as mass_accel_to_Z. + mass_to_Z = 1.0 / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -1243,7 +1241,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif - BT_force_u(I,j) = forces%taux(I,j) * mass_accel_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) else BT_force_u(I,j) = 0.0 endif ; enddo ; enddo @@ -1269,11 +1267,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif - BT_force_v(i,J) = forces%tauy(i,J) * mass_accel_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) else BT_force_v(i,J) = 0.0 endif ; enddo ; enddo - if (associated(taux_bot) .and. associated(tauy_bot)) then + if (associated(taux_bot) .and. associated(tauy_bot)) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) From 6c01c8d65b0fba9ec61a53e3d48058f54c199954 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 28 Nov 2021 10:02:58 -0500 Subject: [PATCH 072/138] (*)Refactored and fixed pseudo_salt_tracer code Refactored the pseudo_salt_tracer code to avoid using fluxes%netSalt, instead calculating the surface fluxes directly from fluxes%saltFlux, in preparation to get rid of the largely redundant fluxes%netSalt element, but also to correct for the fact that fluxes%netSalt does not have proper scaling to pass dimensional consistency testing. Also made the CS%diff element of pseudo_salt_tracer_CS into an allocatable instead of it being a pointer, and changed the tests for whether it is allocated appropriately. Several unused variables were eliminated, and some comments corrected or reformated. This does not impact solutions, but the pseudo_salt and pseudo_salt_diff diagnostics are now invariant to dimensional rescaling, whereas before they were not. All solutions and output in MOM6-examples are bitwise identical. --- src/tracer/pseudo_salt_tracer.F90 | 232 +++++++++++++++--------------- 1 file changed, 117 insertions(+), 115 deletions(-) diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 5ba61923ed..94ee126a59 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -3,25 +3,25 @@ module pseudo_salt_tracer ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : hchksum -use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : query_initialized, MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type +use MOM_debugging, only : hchksum +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface, thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -36,15 +36,15 @@ module pseudo_salt_tracer type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this - !! subroutine [ppt} - real, pointer :: diff(:,:,:) => NULL() !< The difference between the pseudo-salt + !! subroutine [ppt] + real, allocatable :: diff(:,:,:) !< The difference between the pseudo-salt !! tracer and the real salt [ppt]. logical :: pseudo_salt_may_reinit = .true. !< Hard coding since this should not matter - integer :: id_psd = -1 !< A diagnostic ID + integer :: id_psd = -1 !< A diagnostic ID - type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to - !! regulate the timing of diagnostic output. + 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() !< A pointer to the restart control structure type(vardesc) :: tr_desc !< A description and metadata for the pseudo-salt tracer @@ -52,35 +52,32 @@ module pseudo_salt_tracer contains -!> Register the pseudo-salt tracer with MOM6 +!> Register the pseudo-salt tracer with MOM6, and return .true. if the tracer is to be used. function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control - !! structure for the tracer advection and - !! diffusion module - type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control structure ! Local variables character(len=40) :: mdl = "pseudo_salt_tracer" ! This module's name. - character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. - character(len=3) :: name_tag ! String for creating identifying pseudo_salt -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() logical :: register_pseudo_salt_tracer - integer :: isd, ied, jsd, jed, nz, i, j + integer :: isd, ied, jsd, jed, nz isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(WARNING, "register_pseudo_salt_tracer called with an "// & "associated control structure.") + register_pseudo_salt_tracer = .false. return endif allocate(CS) @@ -89,7 +86,6 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call log_version(param_file, mdl, version, "") allocate(CS%ps(isd:ied,jsd:jed,nz), source=0.0) - allocate(CS%diff(isd:ied,jsd:jed,nz), source=0.0) CS%tr_desc = var_desc(trim("pseudo_salt"), "psu", & "Pseudo salt passive tracer", caller=mdl) @@ -113,38 +109,30 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv) 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. + 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_(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. + !! diagnostic output type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. - type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables -! This subroutine initializes the tracer fields in CS%ps(:,:,:). + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer + type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing various thermodynamic variables + + ! This subroutine initializes the tracer fields in CS%ps(:,:,:). ! Local variables - character(len=16) :: name ! A variable's name in a NetCDF file. - character(len=72) :: longname ! The long name of that variable. - character(len=48) :: units ! The dimensions of the variable. - character(len=48) :: flux_units ! The units for age tracer fluxes, either - ! years m3 s-1 or years kg s-1. - logical :: OK - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: IsdB, IedB, JsdB, JedB + character(len=16) :: name ! A variable's name in a NetCDF file + integer :: i, j, k, isd, ied, jsd, jed, nz if (.not.associated(CS)) return - if (.not.associated(CS%diff)) return - 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 + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke CS%Time => day CS%diag => diag @@ -163,83 +151,102 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, CS%id_psd = register_diag_field("ocean_model", "pseudo_salt_diff", CS%diag%axesTL, & day, "Difference between pseudo salt passive tracer and salt tracer", "psu") + if (.not.allocated(CS%diff)) allocate(CS%diff(isd:ied,jsd:jed,nz), source=0.0) end subroutine initialize_pseudo_salt_tracer !> Apply sources, sinks and diapycnal diffusion to the tracers in this package. subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, 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 + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2] 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]. + 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_(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]. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic - !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + 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 thermodynamic and + !! tracer forcing fields + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, intent(in) :: debug !< If true calculate checksums real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep [nondim] + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied [H ~> m or kg m-2] + !! fluxes can be applied [H ~> m or kg m-2] -! This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. + ! This subroutine applies diapycnal diffusion and any other column + ! tracer physics or chemistry to the tracers from this file. -! 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) + ! 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 :: year, h_total, scale, htot, Ih_limit - integer :: secs, days - integer :: i, j, k, is, ie, js, je, nz, k_max + real :: net_salt(SZI_(G),SZJ_(G)) ! Net salt flux into the ocean integrated over + ! a timestep [ppt H ~> ppt m or ppt kg m-2] + real :: htot(SZI_(G)) ! Total ocean depth [H ~> m or kg m-2] + real :: FluxRescaleDepth ! Minimum total ocean depth at which fluxes start to be scaled + ! away [H ~> m or kg m-2] + real :: Ih_limit ! Inverse of FluxRescaleDepth or 0 for no limiting [H-1 ~> m-1 or m2 kg-1] + real :: scale ! Scale scales away fluxes if depth < FluxRescaleDepth [nondim] 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 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return - if (.not.associated(CS%diff)) return + if (.not.associated(CS%ps)) return if (debug) then call hchksum(tv%S,"salt pre pseudo-salt vertdiff", G%HI) call hchksum(CS%ps,"pseudo_salt pre pseudo-salt vertdiff", G%HI) endif - ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then + ! This option uses applyTracerBoundaryFluxesInOut, usually in ALE mode + + ! Determine the time-integrated salt flux, including limiting for small total ocean depths. + net_Salt(:,:) = 0.0 + FluxRescaleDepth = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) + Ih_limit = 0.0 ; if (FluxRescaleDepth > 0.0) Ih_limit = 1.0 / FluxRescaleDepth + do j=js,je + do i=is,ie ; htot(i) = h_old(i,j,1) ; enddo + do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h_old(i,j,k) ; enddo ; enddo + do i=is,ie + scale = 1.0 ; if ((Ih_limit > 0.0) .and. (htot(i)*Ih_limit < 1.0)) scale = htot(i)*Ih_limit + net_salt(i,j) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H + enddo + enddo + do k=1,nz ; do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CS%ps, dt, fluxes, h_work, & - evap_CFL_limit, minimum_forcing_depth, out_flux_optional=fluxes%netSalt) + call applyTracerBoundaryFluxesInOut(G, GV, CS%ps, dt, fluxes, h_work, evap_CFL_limit, & + minimum_forcing_depth, out_flux_optional=net_salt) call tracer_vertdiff(h_work, ea, eb, dt, CS%ps, G, GV) else call tracer_vertdiff(h_old, ea, eb, dt, CS%ps, G, GV) endif - do k=1,nz ; do j=js,je ; do i=is,ie - CS%diff(i,j,k) = CS%ps(i,j,k)-tv%S(i,j,k) - enddo ; enddo ; enddo - if (debug) then - call hchksum(tv%S,"salt post pseudo-salt vertdiff", G%HI) - call hchksum(CS%ps,"pseudo_salt post pseudo-salt vertdiff", G%HI) + call hchksum(tv%S, "salt post pseudo-salt vertdiff", G%HI) + call hchksum(CS%ps, "pseudo_salt post pseudo-salt vertdiff", G%HI) endif - if (CS%id_psd>0) call post_data(CS%id_psd, CS%diff, CS%diag) + if (allocated(CS%diff)) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%diff(i,j,k) = CS%ps(i,j,k) - tv%S(i,j,k) + enddo ; enddo ; enddo + if (CS%id_psd>0) call post_data(CS%id_psd, CS%diff, CS%diag) + endif end subroutine pseudo_salt_tracer_column_physics @@ -247,28 +254,28 @@ end subroutine pseudo_salt_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. 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_(GV)), intent(in) :: 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 + 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 - !! call to register_pseudo_salt_tracer. - character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + !! tracer, in kg times concentration units [kg conc] + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated integer, optional, intent(in) :: stock_index !< The coded index of a specific stock - !! being sought. + !! being sought integer :: pseudo_salt_stock !< Return value: the number of - !! stocks calculated here. + !! stocks calculated here ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pseudo_salt_stock = 0 if (.not.associated(CS)) return - if (.not.associated(CS%diff)) return + if (.not.allocated(CS%diff)) return if (present(stock_index)) then ; if (stock_index > 0) then ! Check whether this stock is available from this routine. @@ -294,22 +301,18 @@ end function pseudo_salt_stock !! 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, GV, CS) - 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(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! 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]. + 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. + !! 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. - integer :: m, 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 - if (.not.associated(CS)) return ! By design, this tracer package does not return any surface states. @@ -319,12 +322,11 @@ end subroutine pseudo_salt_tracer_surface_state !> Deallocate memory associated with this tracer package subroutine pseudo_salt_tracer_end(CS) type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_pseudo_salt_tracer. - integer :: m + !! call to register_pseudo_salt_tracer if (associated(CS)) then if (associated(CS%ps)) deallocate(CS%ps) - if (associated(CS%diff)) deallocate(CS%diff) + if (allocated(CS%diff)) deallocate(CS%diff) deallocate(CS) endif end subroutine pseudo_salt_tracer_end From 111b3e7e66690627c231725399d144d30930fdd7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 28 Nov 2021 10:45:12 -0500 Subject: [PATCH 073/138] +Eliminate forcing%netSalt Eliminated the no-longer used and previously improperly rescaled netSalt element from the forcing type. Also added the missing deallocate statements for fluxes%netMassOut and fluxes%netMassIn in deallocate_forcing_type(). All answers and output are bitwise identical, although an element has been removed from a transparent type. --- src/core/MOM_forcing_type.F90 | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index dced9537d9..62b69994dd 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -103,10 +103,12 @@ module MOM_forcing_type vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1] lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1] frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1] - seaice_melt => NULL(), & !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] + seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] + + ! Aggregated water mass fluxes into the ocean, used for passive tracer sources [R Z T-1 ~> kg m-2 s-1] + real, pointer, dimension(:,:) :: & netMassIn => NULL(), & !< Sum of water mass flux out of the ocean [kg m-2 s-1] - netMassOut => NULL(), & !< Net water mass flux into of the ocean [kg m-2 s-1] - netSalt => NULL() !< Net salt entering the ocean [kgSalt m-2 s-1] + netMassOut => NULL() !< Net water mass flux into of the ocean [kg m-2 s-1] ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & @@ -730,12 +732,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! Diagnostics follow... if (calculate_diags) then - ! Store Net_salt for unknown reason? - if (associated(fluxes%salt_flux)) then - ! This seems like a bad idea to me. -RWH - if (calculate_diags) fluxes%netSalt(i,j) = US%kg_m2s_to_RZ_T*Net_salt(i) - endif - ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. if (associated(fluxes%heat_content_massin)) then @@ -2976,7 +2972,6 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & call myAlloc(fluxes%seaice_melt,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassOut,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassIn,isd,ied,jsd,jed, water) - call myAlloc(fluxes%netSalt,isd,ied,jsd,jed, water) call myAlloc(fluxes%seaice_melt_heat,isd,ied,jsd,jed, heat) call myAlloc(fluxes%sw,isd,ied,jsd,jed, heat) call myAlloc(fluxes%lw,isd,ied,jsd,jed, heat) @@ -3263,6 +3258,8 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%lrunoff)) deallocate(fluxes%lrunoff) if (associated(fluxes%frunoff)) deallocate(fluxes%frunoff) if (associated(fluxes%seaice_melt)) deallocate(fluxes%seaice_melt) + if (associated(fluxes%netMassOut)) deallocate(fluxes%netMassOut) + if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) @@ -3331,7 +3328,6 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) call rotate_array(fluxes_in%seaice_melt, turns, fluxes%seaice_melt) call rotate_array(fluxes_in%netMassOut, turns, fluxes%netMassOut) call rotate_array(fluxes_in%netMassIn, turns, fluxes%netMassIn) - call rotate_array(fluxes_in%netSalt, turns, fluxes%netSalt) endif if (do_heat) then From c54dcc6ce77ccb9ad357eb902179f62cc671d8ee Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Nov 2021 15:13:19 -0500 Subject: [PATCH 074/138] +Clean up dimensional rescaling in write_u_accel Pass wind stresses to write_u_accel() and write_v_accel() in [R L Z T-2 ~> Pa] without requiring external rescaling first. Also cleaned up the dimensional scaling in MOM_PointAccel.F90, so that all arguments and internal variables use the dimensionally rescaled variables with cleaner and standardized syntax, and there are comments clearly describing all real variables in this module. Moreover, several rescaling bugs were corrected in these routines, so that if there are velocity truncations, now the output will be invariant to rescaling, whereas before some reported values were not being properly scaled back to MKS units. All answers and output from the MOM6-examples regression suite are bitwise identical. --- src/diagnostics/MOM_PointAccel.F90 | 310 +++++++++--------- .../vertical/MOM_vert_friction.F90 | 6 +- 2 files changed, 156 insertions(+), 160 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9cbb1e4af0..a4badaf8e7 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -46,14 +46,14 @@ module MOM_PointAccel ! that are used to step the physical model forward. They all use the same ! names as the variables they point to in MOM.F90 real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1]. - v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1]. - u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1]. - v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1]. - T => NULL(), & !< Temperature [degC]. - S => NULL(), & !< Salinity [ppt]. - u_accel_bt => NULL(), & !< Barotropic u-acclerations [L T-2 ~> m s-2] - v_accel_bt => NULL() !< Barotropic v-acclerations [L T-2 ~> m s-2] + u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1] + v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1] + u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1] + v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1] + T => NULL(), & !< Temperature [degC] + S => NULL(), & !< Salinity [ppt] + u_accel_bt => NULL(), & !< Barotropic u-accelerations [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Barotropic v-accelerations [L T-2 ~> m s-2] end type PointAccel_CS contains @@ -61,7 +61,7 @@ module MOM_PointAccel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of zonal velocities over the !! previous timestep. This subroutine is called from vertvisc. -subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rpt, str, a, hv) +subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, str, a, hv) integer, intent(in) :: I !< The zonal index of the column to be documented. integer, intent(in) :: j !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -75,25 +75,25 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms !! in the continuity equations. - real, intent(in) :: dt_in_T !< The ocean dynamics time step [T ~> s]. + real, intent(in) :: dt !< The ocean dynamics time step [T ~> s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - 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, 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 [R L Z T-2 ~> Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. 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 - real :: f_eff, CFL - real :: Angstrom - real :: truncvel, du - real :: dt ! The time step [s] - real :: Inorm(SZK_(GV)) - real :: e(SZK_(GV)+1) - real :: h_scale, uh_scale + real :: CFL ! The local velocity-based CFL number [nondim] + real :: Angstrom ! A negligibly small thickness [H ~> m or kg m-2] + real :: du ! A velocity change [L T-1 ~> m s-1] + real :: Inorm(SZK_(GV)) ! The inverse of the normalized velocity change [L T-1 ~> m s-1] + real :: e(SZK_(GV)+1) ! Simple estimates of interface heights based on the sum of thicknesses [m] + real :: h_scale ! A scaling factor for thicknesses [m H-1 ~> 1 or m3 kg-1] + real :: vel_scale ! A scaling factor for velocities [m T s-1 L-1 ~> 1] + real :: uh_scale ! A scaling factor for transport per unit length [m2 T s-1 L-1 H-1 ~> 1 or m3 kg-1] integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -102,8 +102,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp integer :: file Angstrom = GV%Angstrom_H + GV%H_subroundoff - dt = US%T_to_s*dt_in_T - h_scale = GV%H_to_m ; uh_scale = GV%H_to_m*US%L_T_to_m_s + h_scale = GV%H_to_m ; vel_scale = US%L_T_to_m_s ; uh_scale = GV%H_to_m*US%L_T_to_m_s ! if (.not.associated(CS)) return nz = GV%ke @@ -150,7 +149,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp write (file,'(/,"Time ",i5,i4,F6.2," U-velocity violation at ",I4,": ",2(I3), & & " (",F7.2," E "F7.2," N) Layers ",I3," to ",I3,". dt = ",1PG10.4)') & yr, yearday, (REAL(sec)/3600.0), pe_here(), I, j, & - G%geoLonCu(I,j), G%geoLatCu(I,j), ks, ke, dt + G%geoLonCu(I,j), G%geoLatCu(I,j), ks, ke, US%T_to_s*dt if (ks <= GV%nk_rho_varies) ks = 1 do k=ks,ke @@ -158,98 +157,98 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp enddo write(file,'(/,"Layers:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k) ; enddo write(file,'(/,"u(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*um(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*um(I,j,k)) ; enddo if (prev_avail) then write(file,'(/,"u(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%u_prev(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%u_prev(I,j,k)) ; enddo endif write(file,'(/,"u(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%u_av(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%u_av(I,j,k)) ; enddo write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(um(I,j,k)) * US%s_to_T*dt * G%dy_Cu(I,j) + CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(um(I,j,k)) * US%s_to_T*dt * G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * dt * G%IdxCu(I,j) ; enddo if (prev_avail) then write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))); enddo + (vel_scale*(um(I,j,k)-CS%u_prev(I,j,k))) ; enddo endif write(file,'(/,"CAu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%CAu(I,j,k)) ; enddo write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%PFu(I,j,k)) ; enddo write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%diffu(I,j,k)) ; enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)); enddo + (vel_scale*dt*ADp%gradKEu(I,j,k)) ; enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo + vel_scale*dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)) ; enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - US%L_T_to_m_s*(um(I,j,k) - US%s_to_T*dt*ADp%du_dt_visc(I,j,k)); enddo + vel_scale*(um(I,j,k) - dt*ADp%du_dt_visc(I,j,k)) ; enddo write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k)); enddo + (vel_scale*dt*ADp%du_dt_visc(I,j,k)) ; enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*ADp%du_other(I,j,k)); enddo + (vel_scale*ADp%du_other(I,j,k)) ; enddo endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*US%Z_to_m*dt_in_T; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%Z_to_m*a(I,j,k)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(I,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hv(I,j,k) ; enddo endif - write(file,'(/,"Stress: ",ES10.3)') str + write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) if (associated(CS%u_accel_bt)) then write(file,'("dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)) ; enddo + (vel_scale*dt*CS%u_accel_bt(I,j,k)) ; enddo write(file,'(/)') endif write(file,'(/,"h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j-1,k)) ; enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j-1,k)) ; enddo write(file,'(/,"h-0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j,k)) ; enddo write(file,'(/,"h+0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j,k)) ; enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j+1,k)) ; enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo @@ -258,74 +257,74 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k) ; enddo write(file,'(/,"T+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i+1,j,k) ; enddo endif if (associated(CS%S)) then write(file,'(/,"S-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k) ; enddo write(file,'(/,"S+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i+1,j,k) ; enddo endif if (prev_avail) then write(file,'(/,"v--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i,J-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J-1,k)) ; enddo write(file,'(/,"v-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J,k)) ; enddo write(file,'(/,"v+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i+1,J-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i+1,J-1,k)) ; enddo write(file,'(/,"v++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i+1,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i+1,J,k)) ; enddo endif write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo + (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)) ; enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_av(i,j-1,k)*uh_scale*(hin(i,j-1,k) + hin(i,j,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_prev(i,j-1,k)*uh_scale*(hin(i,j-1,k) + hin(i,j,k))) ; enddo endif write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo + (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)) ; enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_av(i,J,k)*uh_scale*(hin(i,j,k) + hin(i,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_prev(i,J,k)*uh_scale*(hin(i,j,k) + hin(i,j+1,k))) ; enddo endif write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo + (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)) ; enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_av(i+1,J-1,k)*uh_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_prev(i+1,J-1,k)*uh_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))) ; enddo endif write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo + (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)) ; enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*uh_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," vhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*US%L_T_to_m_s*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*uh_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))) ; enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) @@ -333,54 +332,54 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - du = US%L_T_to_m_s*(um(I,j,k) - CS%u_prev(I,j,k)) - if (abs(du) < 1.0e-6) du = 1.0e-6 + du = um(I,j,k) - CS%u_prev(I,j,k) + if (abs(du) < 1.0e-6*US%m_s_to_L_T) du = 1.0e-6*US%m_s_to_L_T Inorm(k) = 1.0 / du enddo write(file,'(2/,"Norm: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/Inorm(k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (vel_scale / Inorm(k)) ; enddo write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo + ((um(I,j,k)-CS%u_prev(I,j,k)) * Inorm(k)) ; enddo write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)*Inorm(k)); enddo + (dt*ADp%CAu(I,j,k) * Inorm(k)) ; enddo write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)*Inorm(k)); enddo + (dt*ADp%PFu(I,j,k) * Inorm(k)) ; enddo write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)*Inorm(k)); enddo + (dt*ADp%diffu(I,j,k) * Inorm(k)) ; enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)*Inorm(k)); enddo + (dt*ADp%gradKEu(I,j,k) * Inorm(k)) ; enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo + (dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)) * Inorm(k)) ; enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo + (dt*ADp%du_dt_visc(I,j,k) * Inorm(k)) ; enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*ADp%du_other(I,j,k))*Inorm(k); enddo + (ADp%du_other(I,j,k) * Inorm(k)) ; enddo endif if (associated(CS%u_accel_bt)) then write(file,'(/,"dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo + (dt*CS%u_accel_bt(I,j,k) * Inorm(k)) ; enddo endif endif @@ -394,7 +393,7 @@ end subroutine write_u_accel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of meridional velocities over !! the previous timestep. This subroutine is called from vertvisc. -subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rpt, str, a, hv) +subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, str, a, hv) integer, intent(in) :: i !< The zonal index of the column to be documented. integer, intent(in) :: J !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -408,25 +407,25 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms in !! the continuity equations. - real, intent(in) :: dt_in_T !< The ocean dynamics time step [T ~> s]. + real, intent(in) :: dt !< The ocean dynamics time step [T ~> s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - 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, 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 [R L Z T-2 ~> Pa] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. 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 - real :: f_eff, CFL - real :: Angstrom - real :: truncvel, dv - real :: dt ! The time step [s] - real :: Inorm(SZK_(GV)) - real :: e(SZK_(GV)+1) - real :: h_scale, uh_scale + real :: CFL ! The local velocity-based CFL number [nondim] + real :: Angstrom ! A negligibly small thickness [H ~> m or kg m-2] + real :: dv ! A velocity change [L T-1 ~> m s-1] + real :: Inorm(SZK_(GV)) ! The inverse of the normalized velocity change [L T-1 ~> m s-1] + real :: e(SZK_(GV)+1) ! Simple estimates of interface heights based on the sum of thicknesses [m] + real :: h_scale ! A scaling factor for thicknesses [m H-1 ~> 1 or m3 kg-1] + real :: vel_scale ! A scaling factor for velocities [m T s-1 L-1 ~> 1] + real :: uh_scale ! A scaling factor for transport per unit length [m2 T s-1 L-1 H-1 ~> 1 or m3 kg-1] integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -435,8 +434,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp integer :: file Angstrom = GV%Angstrom_H + GV%H_subroundoff - dt = US%T_to_s*dt_in_T - h_scale = GV%H_to_m ; uh_scale = GV%H_to_m*US%L_T_to_m_s + h_scale = GV%H_to_m ; vel_scale = US%L_T_to_m_s ; uh_scale = GV%H_to_m*US%L_T_to_m_s ! if (.not.associated(CS)) return nz = GV%ke @@ -482,7 +480,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp write (file,'(/,"Time ",i5,i4,F6.2," V-velocity violation at ",I4,": ",2(I3), & & " (",F7.2," E ",F7.2," N) Layers ",I3," to ",I3,". dt = ",1PG10.4)') & yr, yearday, (REAL(sec)/3600.0), pe_here(), i, J, & - G%geoLonCv(i,J), G%geoLatCv(i,J), ks, ke, dt + G%geoLonCv(i,J), G%geoLatCv(i,J), ks, ke, US%T_to_s*dt if (ks <= GV%nk_rho_varies) ks = 1 do k=ks,ke @@ -490,178 +488,178 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp enddo write(file,'(/,"Layers:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k) ; enddo write(file,'(/,"v(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*vm(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*vm(i,J,k)) ; enddo if (prev_avail) then write(file,'(/,"v(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%v_prev(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J,k)) ; enddo endif write(file,'(/,"v(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%v_av(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_av(i,J,k)) ; enddo write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(vm(i,J,k)) * US%s_to_T*dt * G%dx_Cv(i,J) + CFL = abs(vm(i,J,k)) * dt * G%dx_Cv(i,J) if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(vm(i,J,k)) * US%s_to_T*dt * G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * dt * G%IdyCv(i,J) ; enddo if (prev_avail) then write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))); enddo + (vel_scale*(vm(i,J,k)-CS%v_prev(i,J,k))) ; enddo endif write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%CAv(i,J,k)) ; enddo write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%PFv(i,J,k)) ; enddo write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%diffv(i,J,k)) ; enddo if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)); enddo + (vel_scale*dt*ADp%gradKEv(i,J,k)) ; enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo + vel_scale*dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)) ; enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - US%L_T_to_m_s*(vm(i,J,k) - US%s_to_T*dt*ADp%dv_dt_visc(i,J,k)); enddo + vel_scale*(vm(i,J,k) - dt*ADp%dv_dt_visc(i,J,k)) ; enddo write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)); enddo + (vel_scale*dt*ADp%dv_dt_visc(i,J,k)) ; enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*ADp%dv_other(i,J,k)); enddo + (vel_scale*ADp%dv_other(i,J,k)) ; enddo endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*US%Z_to_m*dt_in_T; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%Z_to_m*a(i,j,k)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(i,J,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hv(i,J,k) ; enddo endif - write(file,'(/,"Stress: ",ES10.3)') str + write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)) ; enddo + (vel_scale*dt*CS%v_accel_bt(i,J,k)) ; enddo write(file,'(/)') endif write(file,'("h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j,k) ; enddo write(file,'(/,"h0-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j,k) ; enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j,k) ; enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j+1,k) ; enddo write(file,'(/,"h0+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) - do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k); enddo + do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo if (associated(CS%T)) then write(file,'(/,"T-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k) ; enddo write(file,'(/,"T+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j+1,k) ; enddo endif if (associated(CS%S)) then write(file,'(/,"S-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k) ; enddo write(file,'(/,"S+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j+1,k) ; enddo endif if (prev_avail) then write(file,'(/,"u--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I-1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I-1,j,k) ; enddo write(file,'(/,"u-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I-1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I-1,j+1,k) ; enddo write(file,'(/,"u+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I,j,k) ; enddo write(file,'(/,"u++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%u_prev(I,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I,j+1,k) ; enddo endif write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo + (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)) ; enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av(I-1,j,k) * uh_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_prev(I-1,j,k) * uh_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))) ; enddo endif write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo + (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)) ; enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_av(I-1,j+1,k) * uh_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_prev(I-1,j+1,k) * uh_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))) ; enddo endif write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo + (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)) ; enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av(I,j,k) * uh_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_prev(I,j,k) * uh_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))) ; enddo endif write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo + (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)) ; enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_av(I,j+1,k) * uh_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))) ; enddo if (prev_avail) then write(file,'(/," uhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I,j+1,k) * h_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_prev(I,j+1,k) * uh_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))) ; enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) @@ -669,50 +667,50 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - dv = US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k)) - if (abs(dv) < 1.0e-6) dv = 1.0e-6 + dv = vm(i,J,k) - CS%v_prev(i,J,k) + if (abs(dv) < 1.0e-6*US%m_s_to_L_T) dv = 1.0e-6*US%m_s_to_L_T Inorm(k) = 1.0 / dv enddo write(file,'(2/,"Norm: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/Inorm(k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (vel_scale / Inorm(k)) ; enddo write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo + ((vm(i,J,k)-CS%v_prev(i,J,k)) * Inorm(k)) ; enddo write(file,'(/,"CAv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo + (dt*ADp%CAv(i,J,k) * Inorm(k)) ; enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)*Inorm(k)); enddo + (dt*ADp%PFv(i,J,k) * Inorm(k)) ; enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)*Inorm(k)); enddo + (dt*ADp%diffv(i,J,k) * Inorm(k)) ; enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)*Inorm(k)); enddo + (dt*ADp%gradKEv(i,J,k) * Inorm(k)) ; enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo + (dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)) * Inorm(k)) ; enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo + (dt*ADp%dv_dt_visc(i,J,k) * Inorm(k)) ; enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (US%L_T_to_m_s*ADp%dv_other(i,J,k)*Inorm(k)); enddo + (ADp%dv_other(i,J,k) * Inorm(k)) ; enddo endif if (associated(CS%v_accel_bt)) then write(file,'(/,"dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo + (dt*CS%v_accel_bt(i,J,k) * Inorm(k)) ; enddo endif endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index f36af41149..b332346c6c 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1491,7 +1491,6 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. real :: CFL ! The local CFL number. 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_(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] @@ -1503,7 +1502,6 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS maxvel = CS%maxvel truncvel = 0.9*maxvel H_report = 6.0 * GV%Angstrom_H - dt_Rho0 = (US%L_T_to_m_s*US%Z_to_m) * dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then !$OMP parallel do default(shared) private(trunc_any,CFL) @@ -1586,7 +1584,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! 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, & - vel_report(I,j), forces%taux(I,j)*dt_Rho0, a=CS%a_u, hv=CS%h_u) + vel_report(I,j), forces%taux(I,j), a=CS%a_u, hv=CS%h_u) endif ; enddo ; enddo endif @@ -1671,7 +1669,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! 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, & - vel_report(i,J), forces%tauy(i,J)*dt_Rho0, a=CS%a_v, hv=CS%h_v) + vel_report(i,J), forces%tauy(i,J), a=CS%a_v, hv=CS%h_v) endif ; enddo ; enddo endif From a65fbed2abb6c3590143972b074faf750cd16de7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 24 Nov 2021 15:10:25 -0500 Subject: [PATCH 075/138] +Rescale fluxes passed to KPP_NonLocalTransport Applied appropriate rescaling for dimensional consistency testing to the net heat and salt fluxes calculated in calculateBuoyancyFlux and used in the two KPP_NonLocalTransport_...() routines. Several comments describing variables were also either corrected or added. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 52 ++++++++--------- .../vertical/MOM_CVMix_KPP.F90 | 57 +++++++++++-------- .../vertical/MOM_diabatic_driver.F90 | 28 ++++----- .../vertical/MOM_opacity.F90 | 7 +-- 4 files changed, 75 insertions(+), 69 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index dced9537d9..9cec8587db 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -925,34 +925,32 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt 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_(GV)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] - real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< Surface heat flux excluding shortwave - !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - real, dimension(SZI_(G)), intent(inout) :: netSalt !< surface salt flux - !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] + real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] + real, dimension(SZI_(G)), intent(out) :: netHeatMinusSW !< Surface heat flux excluding shortwave + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(SZI_(G)), intent(out) :: netSalt !< surface salt flux + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! local variables - integer :: k - real, parameter :: dt = 1. ! to return a rate from extractFluxes1d - real, dimension(SZI_(G)) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] + real, dimension(SZI_(G)) :: netH ! net FW flux [H T-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netEvap ! net FW flux leaving ocean via evaporation - ! [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [H T-1 ~> m s-1 or kg m-2 s-1] + real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band - ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R 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_(GV)+1) :: netPen ! The net penetrating shortwave radiation at each level - ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] logical :: useRiverHeatContent logical :: useCalvingHeatContent real :: depthBeforeScalingFluxes ! A depth scale [H ~> m or kg m-2] - real :: GoRho ! The gravitational acceleration divided by mean density times some - ! unit conversion factors [L2 H-1 s R-1 T-3 ~> m4 kg-1 s-2 or m7 kg-2 s-2] + real :: GoRho ! The gravitational acceleration divided by mean density times a + ! unit conversion factor [L2 H-1 R-1 T-2 ~> m4 kg-1 s-2 or m7 kg-2 s-2] real :: H_limit_fluxes ! Another depth scale [H ~> m or kg m-2] - integer :: i + integer :: i, k ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. @@ -961,25 +959,25 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. if (associated(tv%p_surf)) then ; do i=G%isc,G%iec ; pressure(i) = tv%p_surf(i,j) ; enddo ; endif - GoRho = (GV%g_Earth * GV%H_to_Z*US%T_to_s) / GV%Rho0 + GoRho = (GV%g_Earth * GV%H_to_Z) / GV%Rho0 H_limit_fluxes = depthBeforeScalingFluxes ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: - ! netH = water added/removed via surface fluxes [H s-1 ~> m s-1 or kg m-2 s-1] - ! netHeat = heat via surface fluxes [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - ! netSalt = salt via surface fluxes [ppt H s-1 ~> ppt m s-1 or gSalt m-2 s-1] + ! netH = water added/removed via surface fluxes [H T-1 ~> m s-1 or kg m-2 s-1] + ! netHeat = heat via surface fluxes [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! netSalt = salt via surface fluxes [ppt H T-1 ~> ppt m s-1 or gSalt m-2 s-1] ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux - ! this call returns the rate because dt=1 - call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt*US%s_to_T, & + ! this call returns the rate because dt=1 (in arbitrary time units) + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, 1.0, & depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & netSalt, penSWbnd, tv, .false.) ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, US, h(:,j,:), optics_nbands(optics), optics, j, dt*US%s_to_T, & + call sumSWoverBands(G, GV, US, h(:,j,:), optics_nbands(optics), optics, j, 1.0, & H_limit_fluxes, .true., penSWbnd, netPen) ! Density derivatives @@ -987,12 +985,14 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt tv%eqn_of_state, EOS_domain(G%HI)) ! Adjust netSalt to reflect dilution effect of FW flux - netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) ! ppt H/s + ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) ! Add in the SW heating for purposes of calculating the net ! surface buoyancy flux affecting the top layer. + ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 ) - netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) ! K H/s + netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) ! Convert to a buoyancy flux, excluding penetrating SW heating buoyancyFlux(G%isc:G%iec,1) = - GoRho * ( dRhodS(G%isc:G%iec) * netSalt(G%isc:G%iec) + & @@ -1020,9 +1020,9 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type 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)), intent(inout) :: netHeatMinusSW !< surface heat flux excluding shortwave - !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netSalt !< Net surface salt flux - !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] ! local variables integer :: j diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 5342c621dd..2ff0a21196 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -538,9 +538,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & - 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s') + 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s', conversion=GV%H_to_m*US%s_to_T) CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & - 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s') + 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s', conversion=GV%H_to_m*US%s_to_T) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & @@ -554,13 +554,17 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_NLT_dTdt = register_diag_field('ocean_model', 'KPP_NLT_dTdt', diag%axesTL, Time, & - 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', 'K/s') + 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', & + 'K/s', conversion=US%s_to_T) CS%id_NLT_dSdt = register_diag_field('ocean_model', 'KPP_NLT_dSdt', diag%axesTL, Time, & - 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', 'ppt/s') + 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', & + 'ppt/s', conversion=US%s_to_T) CS%id_NLT_temp_budget = register_diag_field('ocean_model', 'KPP_NLT_temp_budget', diag%axesTL, Time, & - 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', 'W/m^2') + 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', & + 'W/m^2', conversion=US%QRZ_T_to_W_m2) CS%id_NLT_saln_budget = register_diag_field('ocean_model', 'KPP_NLT_saln_budget', diag%axesTL, Time, & - 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', 'kg/(sec*m^2)') + 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', & + 'kg/(sec*m^2)', conversion=US%RZ_T_to_kg_m2s) CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C') CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & @@ -1179,7 +1183,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & zt_cntr = cellHeight(1:GV%ke), & ! Depth of cell center [m] - delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] + delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [m s-2] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] N_iface=CS%N(i,j,:), & ! Buoyancy frequency [s-1] @@ -1285,12 +1289,12 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local - real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration + real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [m] real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] ! (negative in the ocean) 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 :: wc, ww, we, wn, ws ! averaging weights for smoothing [nondim] real :: dh ! The local thickness used for calculating interface positions [m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] integer :: i, j, k, s @@ -1390,13 +1394,14 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & 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 temperature - !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] - real, intent(in) :: dt !< Time-step [s] - 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] + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + real, intent(in) :: dt !< Time-step [T ~> s] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [degC] + real, intent(in) :: C_p !< Seawater specific heat capacity + !! [Q degC-1 ~> J kg-1 degC-1] integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [degC T-1 ~> degC s-1] dtracer(:,:,:) = 0.0 @@ -1431,8 +1436,9 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec + ! Here dtracer has units of [Q R Z T-1 ~> W m-2]. dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * C_p * GV%H_to_kg_m2 + surfFlux(i,j) * C_p * GV%H_to_RZ enddo enddo enddo @@ -1446,18 +1452,18 @@ end subroutine KPP_NonLocalTransport_temp !> This routine is a useful prototype for other material tracers. subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, scalar) - 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_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + 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_(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 salt - !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] - real, intent(in) :: dt !< Time-step [s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + real, intent(in) :: dt !< Time-step [T ~> s] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer + real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [ppt T-1 ~> ppt s-1] dtracer(:,:,:) = 0.0 @@ -1492,8 +1498,9 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, do k = 1, GV%ke do j = G%jsc, G%jec do i = G%isc, G%iec + ! Here dtracer has units of [ppt R Z T-1 ~> ppt kg m-2 s-1] dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * GV%H_to_kg_m2 + surfFlux(i,j) * GV%H_to_RZ enddo enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index bac311bd6d..c0ea3aff53 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -248,9 +248,9 @@ module MOM_diabatic_driver real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [nondim] real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux - !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux - !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] + !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type diabatic_CS @@ -680,17 +680,17 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) + dt, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - US%T_to_s*dt, tv%S) + dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -1255,17 +1255,17 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) + dt, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - US%T_to_s*dt, tv%S) + dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -1877,17 +1877,17 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) + dt, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - US%T_to_s*dt, tv%S) + dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 5dec767f5b..02d49d024d 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -773,7 +773,7 @@ end subroutine absorbRemainingSW !> This subroutine calculates the total shortwave heat flux integrated over !! bands as a function of depth. This routine is only called for computing -!! buoyancy fluxes for use in KPP. This routine does not updat e the state. +!! buoyancy fluxes for use in KPP. This routine does not update the state. subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -793,9 +793,8 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave !! radiation is absorbed in the ocean water column. real, dimension(max(nsw,1),SZI_(G)), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave - !! heating in each band that hits the bottom and - !! will be redistributed through the water column - !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). + !! in each band at the sea surface; size nsw x SZI_(G) + !! [degC H ~> degC m or degC kg m-2]. real, dimension(SZI_(G),SZK_(GV)+1), & intent(inout) :: netPen !< Net penetrating shortwave heat flux at each !! interface, summed across all bands From 32d0a4e65e73fc80e1d1300403d9d4ad862dc1c9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 29 Nov 2021 13:36:46 -0500 Subject: [PATCH 076/138] Refactored DOME_initialize_sponges() (#12) Bitwise identical refactoring of the code in DOME_initialize_sponges, including renaming variables for greater clarity, adding variables for several dimensional constants, and correcting comments. This also includes more careful handling of the DOME OBCs in DOME_set_OBC_data() to hopefully avoid some obvious problems (noted in a comment about a "fight with T,S") that would arise if a DOME case were set up that used temperature and salinity. Future revisions should add more runtime parameters to specify the details of this case, but properly doing so would involve changing the order of arithmetic; this has not happened in this case. All real variables in this module are now described in comments. All answers and output are bitwise identical. Co-authored-by: Marshall Ward --- src/user/DOME_initialization.F90 | 180 ++++++++++++++++--------------- 1 file changed, 94 insertions(+), 86 deletions(-) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index b5c14517c2..23ef41be94 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -40,9 +40,9 @@ module DOME_initialization subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth in [m] or [Z ~> m] if US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D + real, intent(in) :: max_depth !< Maximum model depth [m] or [Z ~> m] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables @@ -139,18 +139,16 @@ end subroutine DOME_initialize_thickness ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -!> This subroutine sets the inverse restoration time (Idamp), and ! -!! the values towards which the interface heights and an arbitrary ! -!! number of tracers should be restored within each sponge. The ! -!! interface height is always subject to damping, and must always be ! -!! the first registered field. ! +!> This subroutine sets the inverse restoration time (Idamp), and the values +!! toward which the interface heights and an arbitrary number of tracers will be +!! restored within the sponges for the DOME configuration. ! subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temperature and - !! salinity or mixed layer density. Absent fields have NULL ptrs. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing any available + !! thermodynamic fields, including potential + !! temperature and salinity or mixed layer density. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: PF !< A structure indicating the open file to @@ -159,12 +157,15 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) !! structure for this module. 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 sponge damping rate [T-1 ~> s-1]. + real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables [various] + real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] - real :: H0(SZK_(GV)) ! Interface heights [Z ~> m]. + real :: e_tgt(SZK_(GV)+1) ! Target 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 :: damp_W, damp_E ! Damping rates in the western and eastern sponges [days-1] + real :: peak_damping ! The maximum sponge damping rates as the edges [days-1] + real :: edge_dist ! The distance to an edge, in the same units as longitude [km] + real :: sponge_width ! The width of the sponges, in the same units as longitude [km] 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 @@ -172,66 +173,61 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) 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 - -! Here the inverse damping time [T-1 ~> s-1], is set. Set Idamp to 0 ! -! wherever there is no sponge, and the subroutines that are called ! -! will automatically set up the sponges only where Idamp is positive! -! and mask2dT is 1. ! - -! Set up sponges for DOME configuration + ! Set up sponges for the DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) - H0(1) = 0.0 - do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo - 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 - else ; damp=0.0 + ! Here the inverse damping time [T-1 ~> s-1], is set. Set Idamp to 0 wherever + ! there is no sponge, and the subroutines that are called will automatically + ! set up the sponges only where Idamp is positive and mask2dT is 1. + peak_damping = 10.0 ! The maximum sponge damping rate in [days-1] + sponge_width = 200.0 ! The width of the sponges [km] + Idamp(:,:) = 0.0 + do j=js,je ; do i=is,ie ; if (depth_tot(i,j) > min_depth) then + edge_dist = G%geoLonT(i,j) - G%west_lon + if (edge_dist < 0.5*sponge_width) then + damp_W = peak_damping + elseif (edge_dist < sponge_width) then + damp_W = peak_damping * (sponge_width - edge_dist) / (0.5*sponge_width) + else + damp_W = 0.0 endif - if (G%geoLonT(i,j) > 1400.0) then ; damp_new = 10.0 - elseif (G%geoLonT(i,j) > 1300.0) then - damp_new = 10.0 * (G%geoLonT(i,j)-1300.0)/100.0 - else ; damp_new = 0.0 + edge_dist = (G%len_lon + G%west_lon) - G%geoLonT(i,j) + if (edge_dist < 0.5*sponge_width) then + damp_E = peak_damping + elseif (edge_dist < sponge_width) then + damp_E = peak_damping * (sponge_width - edge_dist) / (0.5*sponge_width) + else + damp_E = 0.0 endif - if (damp <= damp_new) damp = damp_new - damp = US%T_to_s*damp - - ! These will be stretched inside of apply_sponge, so they can be in - ! depth space for Boussinesq or non-Boussinesq models. - eta(i,j,1) = 0.0 - do k=2,nz -! eta(i,j,K) = max(H0(k), -depth_tot(i,j), GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j)) - e_dense = -depth_tot(i,j) - if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense - else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j)) & - eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j) - enddo - eta(i,j,nz+1) = -depth_tot(i,j) - - if (depth_tot(i,j) > min_depth) then - Idamp(i,j) = damp / 86400.0 - else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo + Idamp(i,j) = max(damp_W, damp_E) / (86400.0 * US%s_to_T) + endif ; enddo ; enddo + + e_tgt(1) = 0.0 + do K=2,nz ; e_tgt(K) = -(real(K-1)-0.5)*G%max_depth / real(nz-1) ; enddo + e_tgt(nz+1) = -G%max_depth + eta(:,:,:) = 0.0 + do K=1,nz+1 ; do j=js,je ; do i=is,ie + ! These target interface heights will be rescaled inside of apply_sponge, so + ! they can be in depth space for Boussinesq or non-Boussinesq models. + eta(i,j,K) = max(e_tgt(K), GV%Angstrom_Z*(nz+1-K) - depth_tot(i,j)) + enddo ; enddo ; enddo -! This call sets up the damping rates and interface heights. -! This sets the inverse damping timescale fields in the sponges. ! + ! This call stores the sponge damping rates and target interface heights. call initialize_sponge(Idamp, eta, G, PF, CSp, GV) -! Now register all of the fields which are damped in the sponge. ! -! By default, momentum is advected vertically within the sponge, but ! -! momentum is typically not damped within the sponge. ! + ! Now register all of the fields which are damped in the sponge. + ! By default, momentum is advected vertically within the sponge, but + ! momentum is typically not damped within the layer-mode sponge. -! At this point, the DOME configuration is done. The following are here as a +! At this point, the layer-mode DOME configuration is done. The following are here as a ! template for other configurations. -! The remaining calls to set_up_sponge_field can be in any order. ! + ! The remaining calls to set_up_sponge_field can be in any order. if ( associated(tv%T) ) then + temp(:,:,:) = 0.0 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. @@ -283,26 +279,34 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. -! Local variables - ! The following variables are used to set the target temperature and salinity. - real :: T0(SZK_(GV)) ! A profile of temperatures [degC] - real :: S0(SZK_(GV)) ! A profile of salinities [ppt] + ! Local variables + real :: T0(SZK_(GV)) ! A profile of target temperatures [degC] + real :: S0(SZK_(GV)) ! A profile of target 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 - ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2]. - real :: Def_Rad ! The deformation radius, based on fluid of - ! thickness D_edge, in the same units as lat [m]. + real :: tr_0 ! The total integrated inflow transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: tr_k ! The integrated inflow transport of a layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: v_k ! The velocity of a layer at the edge [L T-1 ~> m s-1] + real :: yt, yb ! The log of these variables gives the fractional velocities at the + ! top and bottom of a layer [nondim] + real :: rst, rsb ! The relative position of the top and bottom of a layer [nondim], + ! with a range from 0 for the densest water to -1 for the lightest + real :: rc ! The relative position of the center of a layer [nondim] + real :: lon_im1 ! An extrapolated value for the longitude of the western edge of a + ! v-velocity face, in the same units as G%geoLon [km] + real :: D_edge ! The thickness [Z ~> m] of the dense fluid at the + ! inner edge of the inflow + real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2] + real :: Def_Rad ! The deformation radius, based on fluid of thickness D_edge, + ! in the same units as G%geoLon [km] real :: Ri_trans ! The shear Richardson number in the transition - ! region of the specified shear profile. + ! region of the specified shear profile [nondim] character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. character(len=32) :: name ! The name of a tracer field. - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz, ntherm integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() type(tracer_type), pointer :: tr_ptr => NULL() @@ -330,7 +334,11 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) segment => OBC%segment(1) if (.not. segment%on_pe) return - allocate(segment%field(tr_Reg%ntr)) + ! Set up space for the OBCs to use for all the tracers. + ntherm = 0 + if (associated(tv%S)) ntherm = ntherm + 1 + if (associated(tv%T)) ntherm = ntherm + 1 + allocate(segment%field(ntherm+tr_Reg%ntr)) do k=1,nz rst = -1.0 @@ -341,10 +349,10 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) rc = -1.0 + real(k-1)/real(nz-1) ! These come from assuming geostrophy and a constant Ri profile. - y1 = (2.0*Ri_trans*rst + Ri_trans + 2.0)/(2.0 - Ri_trans) - y2 = (2.0*Ri_trans*rsb + Ri_trans + 2.0)/(2.0 - Ri_trans) + yt = (2.0*Ri_trans*rst + Ri_trans + 2.0)/(2.0 - Ri_trans) + yb = (2.0*Ri_trans*rsb + Ri_trans + 2.0)/(2.0 - Ri_trans) tr_k = tr_0 * (2.0/(Ri_trans*(2.0-Ri_trans))) * & - ((log(y1)+1.0)/y1 - (log(y2)+1.0)/y2) + ((log(yt)+1.0)/yt - (log(yb)+1.0)/yb) v_k = -sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & (2.0 - Ri_trans)) if (k == nz) tr_k = tr_k + tr_0 * (2.0/(Ri_trans*(2.0+Ri_trans))) * & @@ -353,6 +361,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) isd = segment%HI%isd ; ied = segment%HI%ied JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB do J=JsdB,JedB ; do i=isd,ied + ! Here lon_im1 estimates G%geoLonBu(I-1,J), which may not have been set if + ! the symmetric memory mode is not being used. lon_im1 = 2.0*G%geoLonCv(i,J) - G%geoLonBu(I,J) segment%normal_trans(i,J,k) = tr_k * (exp(-2.0*(lon_im1 - 1000.0)/Def_Rad) -& exp(-2.0*(G%geoLonBu(I,J) - 1000.0)/Def_Rad)) @@ -383,7 +393,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo - ! Temperature on tracer 1??? + ! Temperature is tracer 1 for the OBCs. allocate(segment%field(1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied segment%field(1)%buffer_src(i,j,k) = T0(k) @@ -393,18 +403,17 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.true.) endif - ! Dye tracers - fight with T,S??? + ! Set up dye tracers ! First dye - only one with OBC values - ! This field(1) requires tr_D1 to be the first tracer. - allocate(segment%field(1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) + ! This field(ntherm+1) requires tr_D1 to be the first tracer after temperature and salinity. + allocate(segment%field(ntherm+1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%isd,segment%HI%ied - if (k < nz/2) then ; segment%field(1)%buffer_src(i,j,k) = 0.0 - else ; segment%field(1)%buffer_src(i,j,k) = 1.0 ; endif + if (k < nz/2) then ; segment%field(ntherm+1)%buffer_src(i,j,k) = 0.0 + else ; segment%field(ntherm+1)%buffer_src(i,j,k) = 1.0 ; endif enddo ; enddo ; enddo name = 'tr_D1' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, & - OBC%segment(1), OBC_array=.true.) + call register_segment_tracer(tr_ptr, param_file, GV, OBC%segment(1), OBC_array=.true.) ! All tracers but the first have 0 concentration in their inflows. As 0 is the ! default value for the inflow concentrations, the following calls are unnecessary. @@ -412,8 +421,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, param_file, GV, & - OBC%segment(1), OBC_scalar=0.0) + call register_segment_tracer(tr_ptr, param_file, GV, OBC%segment(1), OBC_scalar=0.0) enddo end subroutine DOME_set_OBC_data From ec84be587f53ec7a5241952aefcd4b4d41515288 Mon Sep 17 00:00:00 2001 From: sditkovsky <70655988+sditkovsky@users.noreply.github.com> Date: Mon, 29 Nov 2021 13:59:47 -0500 Subject: [PATCH 077/138] change conversion H_to_MKS to H_to_m for u/veffA * also small fix to porous module. invert order of do loops --- src/core/MOM_dynamics_split_RK2.F90 | 4 ++-- src/core/MOM_dynamics_unsplit.F90 | 4 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 ++-- src/core/MOM_porous_barriers.F90 | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index e3f30417ef..7cf42319e4 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1542,10 +1542,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive = .true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive = .true.) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index e52085c2d5..99d092a7f6 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -707,10 +707,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + 'Effective U Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive = .true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + 'Effective V Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive = .true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index f8112fe4cd..9730fb22fd 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -668,10 +668,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive = .true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V-Face Area', 'm^2', conversion = GV%H_to_MKS*US%L_to_m, & + 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive = .true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index b20fb993e0..d23509d5f6 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -91,7 +91,7 @@ subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) endif enddo; enddo - do i=isd,ied; do J=JsdB,JedB + do J=JsdB,JedB; do i=isd,ied if (G%porous_DavgV(i,J) < 0.) then do K = nk+1,1,-1 eta_s = max(eta(i,J,K), eta(i,J+1,K)) !take shallower layer height From 13a1cde097bed11c3dee1f01216025b9693caa27 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 29 Nov 2021 14:39:51 -0500 Subject: [PATCH 078/138] +Rescaled flux arguments to tracer_vertdiff() Changed the units of the optional surface and bottom tracer fluxes, sink rate, and bottom tracer reservoir arguments to tracer_vertdiff() and tracer_vertdiff_Eulerian() to fully rescaled units (like [Conc R Z T-1] and [Z T-1]) for greater dimensional consistency testing. Only the two CFC packages are using the flux arguments, so they were rescaled in those modules as well. Several unused variables or unnecessary pointers were removed from the CFC tracer modules, and some comments were revised or added to indicate the dimensions of a number of internal variables in these same modules. All answers are bitwise identical in the MOM6-examples regression suite, and only dimensional rescaling factors are changed (so nothing will have changed without any rescaling), but it should be noted that testing of the CFC tracer packages is less comprehensive than would be ideal. --- src/core/MOM_forcing_type.F90 | 25 ++++++------ src/tracer/MOM_CFC_cap.F90 | 63 ++++++++++++------------------ src/tracer/MOM_OCMIP2_CFC.F90 | 42 +++++++------------- src/tracer/MOM_tracer_diabatic.F90 | 30 +++++++------- 4 files changed, 67 insertions(+), 93 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9cec8587db..1f0d725f44 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -185,8 +185,8 @@ module MOM_forcing_type ! CFC-related arrays needed in the MOM_CFC_cap module real, pointer, dimension(:,:) :: & - cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU Z T-1 kg m-3 = mol Z T-1 m-3 ~> mol m-2 s-1]. - cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU Z T-1 kg m-3 = mol Z T-1 m-3 ~> mol m-2 s-1]. + cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] + cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] ice_fraction => NULL(), & !< fraction of sea ice coverage at h-cells, from 0 to 1 [nondim]. u10_sqr => NULL() !< wind magnitude at 10 m squared [L2 T-2 ~> m2 s-2] @@ -1093,20 +1093,19 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat", G%HI, & haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%p_surf)) & - call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf", G%HI, haloshift=hshift , scale=US%RL2_T2_to_Pa) + call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf", G%HI, haloshift=hshift, scale=US%RL2_T2_to_Pa) if (associated(fluxes%u10_sqr)) & - call hchksum(fluxes%u10_sqr, mesg//" fluxes%u10_sqr", G%HI, haloshift=hshift , scale=US%L_to_m**2*US%s_to_T**2) + call hchksum(fluxes%u10_sqr, mesg//" fluxes%u10_sqr", G%HI, haloshift=hshift, scale=US%L_to_m**2*US%s_to_T**2) if (associated(fluxes%ice_fraction)) & call hchksum(fluxes%ice_fraction, mesg//" fluxes%ice_fraction", G%HI, haloshift=hshift) if (associated(fluxes%cfc11_flux)) & - call hchksum(fluxes%cfc11_flux, mesg//" fluxes%cfc11_flux", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) + call hchksum(fluxes%cfc11_flux, mesg//" fluxes%cfc11_flux", G%HI, haloshift=hshift, scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%cfc12_flux)) & - call hchksum(fluxes%cfc12_flux, mesg//" fluxes%cfc12_flux", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) + call hchksum(fluxes%cfc12_flux, mesg//" fluxes%cfc12_flux", G%HI, haloshift=hshift, scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%salt_flux)) & call hchksum(fluxes%salt_flux, mesg//" fluxes%salt_flux", G%HI, haloshift=hshift, scale=US%RZ_T_to_kg_m2s) if (associated(fluxes%TKE_tidal)) & - call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal", G%HI, haloshift=hshift, & - scale=US%RZ3_T3_to_W_m2) + call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal", G%HI, haloshift=hshift, scale=US%RZ3_T3_to_W_m2) if (associated(fluxes%ustar_tidal)) & call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%lrunoff)) & @@ -1305,22 +1304,22 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, endif endif - ! units for cfc11_flux and cfc12_flux are mol m-2 s-1 + ! units for cfc11_flux and cfc12_flux are [Conc R Z T-1 ~> mol m-2 s-1] ! See: ! http://clipc-services.ceda.ac.uk/dreq/u/0940cbee6105037e4b7aa5579004f124.html ! http://clipc-services.ceda.ac.uk/dreq/u/e9e21426e4810d0bb2d3dddb24dbf4dc.html if (present(use_cfcs)) then if (use_cfcs) then handles%id_cfc11 = register_diag_field('ocean_model', 'cfc11_flux', diag%axesT1, Time, & - 'Gas exchange flux of CFC11 into the ocean ', 'mol m-2 s-1', & - conversion= US%Z_to_m*US%s_to_T,& + 'Gas exchange flux of CFC11 into the ocean ', & + 'mol m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & cmor_field_name='fgcfc11', & cmor_long_name='Surface Downward CFC11 Flux', & cmor_standard_name='surface_downward_cfc11_flux') handles%id_cfc12 = register_diag_field('ocean_model', 'cfc12_flux', diag%axesT1, Time, & - 'Gas exchange flux of CFC12 into the ocean ', 'mol m-2 s-1', & - conversion= US%Z_to_m*US%s_to_T,& + 'Gas exchange flux of CFC12 into the ocean ', & + 'mol m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & cmor_field_name='fgcfc12', & cmor_long_name='Surface Downward CFC12 Flux', & cmor_standard_name='surface_downward_cfc12_flux') diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 216b74c735..084fac2b7a 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -304,46 +304,37 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, pointer, dimension(:,:,:) :: CFC11 => NULL(), CFC12 => NULL() real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] - real :: scale_factor ! convert from cfc1[12]_flux to units of sfc_flux in tracer_vertdiff integer :: i, j, k, m, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return - ! set factor to convert from cfc1[12]_flux units to tracer_vertdiff argument sfc_flux units - ! cfc1[12]_flux units are CU Z T-1 kg m-3 - ! tracer_vertdiff argument sfc_flux units are CU kg m-2 T-1 - scale_factor = US%Z_to_m - - CFC11 => CS%CFC11 ; CFC12 => CS%CFC12 - ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC11, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC11, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC11, G, GV, sfc_flux=fluxes%cfc11_flux*scale_factor) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC12, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC12, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC12, G, GV, sfc_flux=fluxes%cfc12_flux*scale_factor) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) else - call tracer_vertdiff(h_old, ea, eb, dt, CFC11, G, GV, sfc_flux=fluxes%cfc11_flux*scale_factor) - call tracer_vertdiff(h_old, ea, eb, dt, CFC12, G, GV, sfc_flux=fluxes%cfc12_flux*scale_factor) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) endif ! If needed, write out any desired diagnostics from tracer sources & sinks here. - if (CS%id_cfc11_cmor > 0) call post_data(CS%id_cfc11_cmor, (GV%Rho0*US%R_to_kg_m3)*CFC11, CS%diag) - if (CS%id_cfc12_cmor > 0) call post_data(CS%id_cfc12_cmor, (GV%Rho0*US%R_to_kg_m3)*CFC12, CS%diag) + if (CS%id_cfc11_cmor > 0) call post_data(CS%id_cfc11_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC11, CS%diag) + if (CS%id_cfc12_cmor > 0) call post_data(CS%id_cfc12_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC12, CS%diag) end subroutine CFC_cap_column_physics @@ -449,11 +440,10 @@ subroutine CFC_cap_fluxes(fluxes, sfc_state, G, US, Rho0, Time, id_cfc11_atm, id real :: sal ! Surface salinity [PSU]. real :: alpha_11 ! The solubility of CFC 11 [mol kg-1 atm-1]. real :: alpha_12 ! The solubility of CFC 12 [mol kg-1 atm-1]. - real :: sc_11, sc_12 ! The Schmidt numbers of CFC 11 and CFC 12. + real :: sc_11, sc_12 ! The Schmidt numbers of CFC 11 and CFC 12 [nondim]. real :: kw_coeff ! A coefficient used to compute the piston velocity [Z T-1 T2 L-2 = Z T L-2 ~> s / m] - real :: Rho0_kg_m3 ! Rho0 in non-scaled units [kg m-3] - real, parameter :: pa_to_atm = 9.8692316931427e-6 ! factor for converting from Pa to atm. - real :: press_to_atm ! converts from model pressure units to atm + real, parameter :: pa_to_atm = 9.8692316931427e-6 ! factor for converting from Pa to atm [atm Pa-1]. + real :: press_to_atm ! converts from model pressure units to atm [atm T2 R-1 L-2 ~> atm Pa-1] integer :: i, j, m, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -488,7 +478,6 @@ subroutine CFC_cap_fluxes(fluxes, sfc_state, G, US, Rho0, Time, id_cfc11_atm, id kw_coeff = (US%m_to_Z*US%s_to_T*US%L_to_m**2) * 6.97e-7 ! set unit conversion factors - Rho0_kg_m3 = Rho0 * US%R_to_kg_m3 press_to_atm = US%R_to_kg_m3*US%L_T_to_m_s**2 * pa_to_atm do j=js,je ; do i=is,ie @@ -506,14 +495,14 @@ subroutine CFC_cap_fluxes(fluxes, sfc_state, G, US, Rho0, Time, id_cfc11_atm, id kw_wo_sc_no_term(i,j) = kw_coeff * ((1.0 - fluxes%ice_fraction(i,j))*fluxes%u10_sqr(i,j)) ! air concentrations and cfcs BC's fluxes - ! CFC flux units: CU Z T-1 kg m-3 = mol kg-1 Z T-1 kg m-3 ~> mol m-2 s-1 + ! CFC flux units: CU R Z T-1 = mol kg-1 R Z T-1 ~> mol m-2 s-1 kw(i,j) = kw_wo_sc_no_term(i,j) * sqrt(660.0 / sc_11) cair(i,j) = press_to_atm * alpha_11 * cfc11_atm(i,j) * fluxes%p_surf_full(i,j) - fluxes%cfc11_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC11(i,j)) * Rho0_kg_m3 + fluxes%cfc11_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC11(i,j)) * Rho0 kw(i,j) = kw_wo_sc_no_term(i,j) * sqrt(660.0 / sc_12) cair(i,j) = press_to_atm * alpha_12 * cfc12_atm(i,j) * fluxes%p_surf_full(i,j) - fluxes%cfc12_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC12(i,j)) * Rho0_kg_m3 + fluxes%cfc12_flux(i,j) = kw(i,j) * (cair(i,j) - sfc_state%sfc_CFC12(i,j)) * Rho0 enddo ; enddo end subroutine CFC_cap_fluxes @@ -524,7 +513,7 @@ subroutine get_solubility(alpha_11, alpha_12, ta, sal , mask) real, intent(inout) :: alpha_12 !< The solubility of CFC 12 [mol kg-1 atm-1] real, intent(in ) :: ta !< Absolute sea surface temperature [hectoKelvin] real, intent(in ) :: sal !< Surface salinity [PSU]. - real, intent(in ) :: mask !< ocean mask + real, intent(in ) :: mask !< ocean mask [nondim] ! Local variables @@ -574,17 +563,17 @@ subroutine comp_CFC_schmidt(sst_in, cfc11_sc, cfc12_sc) real, intent(inout) :: cfc12_sc !< Schmidt number of CFC12 [nondim]. !local variables - real , parameter :: a_11 = 3579.2 - real , parameter :: b_11 = -222.63 - real , parameter :: c_11 = 7.5749 - real , parameter :: d_11 = -0.14595 - real , parameter :: e_11 = 0.0011874 - real , parameter :: a_12 = 3828.1 - real , parameter :: b_12 = -249.86 - real , parameter :: c_12 = 8.7603 - real , parameter :: d_12 = -0.1716 - real , parameter :: e_12 = 0.001408 - real :: sst + real , parameter :: a_11 = 3579.2 ! CFC11 Schmidt number fit coefficient [nondim] + real , parameter :: b_11 = -222.63 ! CFC11 Schmidt number fit coefficient [degC-1] + real , parameter :: c_11 = 7.5749 ! CFC11 Schmidt number fit coefficient [degC-2] + real , parameter :: d_11 = -0.14595 ! CFC11 Schmidt number fit coefficient [degC-3] + real , parameter :: e_11 = 0.0011874 ! CFC11 Schmidt number fit coefficient [degC-4] + real , parameter :: a_12 = 3828.1 ! CFC12 Schmidt number fit coefficient [nondim] + real , parameter :: b_12 = -249.86 ! CFC12 Schmidt number fit coefficient [degC-1] + real , parameter :: c_12 = 8.7603 ! CFC12 Schmidt number fit coefficient [degC-2] + real , parameter :: d_12 = -0.1716 ! CFC12 Schmidt number fit coefficient [degC-3] + real , parameter :: e_12 = 0.001408 ! CFC12 Schmidt number fit coefficient [degC-4] + real :: sst ! A range-limited sea surface temperature [degC] ! clip SST to avoid bad values diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index df86300351..5168dac502 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -31,9 +31,6 @@ module MOM_OCMIP2_CFC public OCMIP2_CFC_column_physics, OCMIP2_CFC_surface_state public OCMIP2_CFC_stock, OCMIP2_CFC_end - -integer, parameter :: NTR = 2 !< the number of tracers in this module. - !> The control structure for the OCMPI2_CFC tracer package type, public :: OCMIP2_CFC_CS ; private character(len=200) :: IC_file !< The file in which the CFC initial values can @@ -96,18 +93,16 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), & pointer :: tr_Reg !< A pointer to the tracer registry. type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. ! Local variables character(len=40) :: mdl = "MOM_OCMIP2_CFC" ! This module's name. character(len=200) :: inputdir ! The directory where NetCDF input files are. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" real, dimension(:,:,:), pointer :: tr_ptr => NULL() real :: a11_dflt(4), a12_dflt(4) ! Default values of the various coefficients - real :: d11_dflt(4), d12_dflt(4) ! In the expressions for the solubility and - real :: e11_dflt(3), e12_dflt(3) ! Schmidt numbers. + real :: d11_dflt(4), d12_dflt(4) ! in the expressions for the solubility and + real :: e11_dflt(3), e12_dflt(3) ! Schmidt numbers [various units by element]. character(len=48) :: flux_units ! The units for tracer fluxes. logical :: register_OCMIP2_CFC integer :: isd, ied, jsd, jed, nz, m @@ -330,10 +325,6 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for !! the sponges, if they are in use. !! Otherwise this may be unassociated. -! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. - - logical :: from_file = .false. if (.not.associated(CS)) return @@ -441,9 +432,8 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! Local variables 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() + CFC11_flux, & ! The fluxes of CFC11 and CFC12 into the ocean, in unscaled units of + CFC12_flux ! CFC concentrations times meters per second [CU R Z T-1 ~> CU kg m-2 s-1] 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) @@ -452,15 +442,13 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (.not.associated(CS)) return - CFC11 => CS%CFC11 ; CFC12 => CS%CFC12 - ! These two calls unpack the fluxes from the input arrays. - ! The -GV%Rho0 changes the sign convention of the flux and changes the units - ! of the flux from [Conc. m s-1] to [Conc. kg m-2 T-1]. + ! The -GV%Rho0 changes the sign convention of the flux and with the scaling factors changes + ! the units of the flux from [Conc. m s-1] to [Conc. R Z T-1 ~> Conc. kg m-2 s-1]. call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_11_flux, CFC11_flux, & - scale_factor=-GV%Rho0*US%R_to_kg_m3*US%T_to_s, idim=idim, jdim=jdim) + scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim) call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_12_flux, CFC12_flux, & - scale_factor=-GV%Rho0*US%R_to_kg_m3*US%T_to_s, idim=idim, jdim=jdim) + scale_factor=-GV%Rho0*US%m_to_Z*US%T_to_s, idim=idim, jdim=jdim) ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. @@ -468,19 +456,19 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC11, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC11, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC11, G, GV, sfc_flux=CFC11_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=CFC11_flux) do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CFC12, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC12, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CFC12, G, GV, sfc_flux=CFC12_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=CFC12_flux) else - call tracer_vertdiff(h_old, ea, eb, dt, CFC11, G, GV, sfc_flux=CFC11_flux) - call tracer_vertdiff(h_old, ea, eb, dt, CFC12, G, GV, sfc_flux=CFC12_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=CFC11_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=CFC12_flux) endif ! Write out any desired diagnostics from tracer sources & sinks here. diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index c1e39598cc..548b2c2155 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -35,17 +35,17 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration in concentration units [CU] real, intent(in) :: dt !< amount of time covered by this call [T ~> s] real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units of - !! [CU kg m-2 T-1 ~> CU kg m-2 s-1] or + !! [CU R Z T-1 ~> CU kg m-2 s-1] or !! [CU H ~> CU m or CU kg m-2] if !! convert_flux_in is .false. real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the - !! tracer in [CU kg m-2 T-1 ~> CU kg m-2 s-1] or + !! tracer in [CU R Z T-1 ~> CU kg m-2 s-1] or !! [CU H ~> CU m or CU kg m-2] if !! convert_flux_in is .false. real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir - !! [CU kg m-2]; formerly [CU m] + !! [CU R Z ~> CU kg m-2] real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks - !! [m T-1 ~> m s-1] + !! [Z T-1 ~> m s-1] logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time @@ -83,7 +83,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (present(convert_flux_in)) convert_flux = convert_flux_in h_neglect = GV%H_subroundoff sink_dist = 0.0 - if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%m_to_H + if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%Z_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 @@ -91,7 +91,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (convert_flux) then !$OMP do do j=js,je ; do i=is,ie - sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H + sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%RZ_to_H enddo ; enddo else !$OMP do @@ -104,7 +104,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & if (convert_flux) then !$OMP do do j=js,je ; do i=is,ie - btm_src(i,j) = (btm_flux(i,j)*dt) * GV%kg_m2_to_H + btm_src(i,j) = (btm_flux(i,j)*dt) * GV%RZ_to_H enddo ; enddo else !$OMP do @@ -174,8 +174,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & (ea(i,j,nz) + sink(i,nz)) * tr(i,j,nz-1)) endif ; enddo if (present(btm_reservoir)) then ; do i=is,ie ; if (G%mask2dT(i,j)>0.5) then - btm_reservoir(i,j) = btm_reservoir(i,j) + & - (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_kg_m2 + btm_reservoir(i,j) = btm_reservoir(i,j) + (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_RZ endif ; enddo ; endif do k=nz-1,1,-1 ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then @@ -233,7 +232,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration in concentration units [CU] real, intent(in) :: dt !< amount of time covered by this call [T ~> s] real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units of - !! [CU kg m-2 T-1 ~> CU kg m-2 s-1] or + !! [CU R Z T-1 ~> CU kg m-2 s-1] or !! [CU H ~> CU m or CU kg m-2] if !! convert_flux_in is .false. real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the @@ -241,9 +240,9 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & !! [CU H ~> CU m or CU kg m-2] if !! convert_flux_in is .false. real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir - !! [CU kg m-2]; formerly [CU m] + !! [CU R Z ~> CU kg m-2] real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks - !! [m T-1 ~> m s-1] + !! [Z T-1 ~> m s-1] logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time @@ -282,7 +281,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & if (present(convert_flux_in)) convert_flux = convert_flux_in h_neglect = GV%H_subroundoff sink_dist = 0.0 - if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%m_to_H + if (present(sink_rate)) sink_dist = (dt*sink_rate) * GV%Z_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 @@ -290,7 +289,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & if (convert_flux) then !$OMP do do j=js,je ; do i=is,ie - sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H + sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%RZ_to_H enddo ; enddo else !$OMP do @@ -373,8 +372,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, & (ent(i,j,nz) + sink(i,nz)) * tr(i,j,nz-1)) endif ; enddo if (present(btm_reservoir)) then ; do i=is,ie ; if (G%mask2dT(i,j)>0.5) then - btm_reservoir(i,j) = btm_reservoir(i,j) + & - (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_kg_m2 + btm_reservoir(i,j) = btm_reservoir(i,j) + (sink(i,nz+1)*tr(i,j,nz)) * GV%H_to_RZ endif ; enddo ; endif do k=nz-1,1,-1 ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then From 3597433148989c0617fe4f50f7e98e0b09a39e01 Mon Sep 17 00:00:00 2001 From: He Wang Date: Mon, 29 Nov 2021 21:27:43 -0500 Subject: [PATCH 079/138] Bug fix for reading First_direction from restart * A bug on reading parameter First_direction from the restart is fixed. Previously, it only works when rotate_index is .true. * A FATAL error is now issued when both ROTATE_INDEX and ALTERNATE_FIRST_DIRECTION are .true. This should only be treated as a temporary patch. * Local variable first_direction in initialize_MOM is slightly repurposed to exclude any modication by rotate_index turns. This helps clarify the meaning of First_direction in restart files, making it independent from index rotation. --- src/core/MOM.F90 | 35 ++++++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 11 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index d3c3570ca2..381d8b58b7 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1755,8 +1755,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations. integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the - ! calculation. This can be altered during the course - ! of the run via calls to set_first_direction. + ! calculation. integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. @@ -2027,7 +2026,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "direction updates occur first in directionally split parts of the calculation. "//& "If this is true, FIRST_DIRECTION applies at the start of a new run or if "//& "the next first direction can not be found in the restart file.", default=.false.) - call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", CS%check_bad_sfc_vals, & "If true, check the surface state for ridiculous values.", & default=.false.) @@ -2125,6 +2123,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (num_PEs() /= 1) & call MOM_error(FATAL, "Index rotation is only supported on one PE.") + ! Alternate_first_direction is not permitted with index rotation. + ! This feature can be added later in the future if needed. + if (CS%alternate_first_direction) & + call MOM_error(FATAL, "Alternating_first_direction is not compatible with index rotation.") + call get_param(param_file, "MOM", "INDEX_TURNS", turns, & "Number of counterclockwise quarter-turn index rotations.", & default=1, debuggingParam=.true.) @@ -2152,7 +2155,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%rotate_index) then allocate(CS%G) call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, domain_name="MOM_rot") - first_direction = modulo(first_direction + turns, 2) else CS%G => G_in endif @@ -2420,8 +2422,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif ! Set a few remaining fields that are specific to the ocean grid type. - call set_first_direction(G, first_direction) - CS%first_dir_restart = real(G%first_direction) + if (CS%rotate_index) then + call set_first_direction(G, modulo(first_direction + turns, 2)) + else + call set_first_direction(G, modulo(first_direction, 2)) + endif ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) @@ -2470,11 +2475,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%tv%S => CS%S endif - ! Reset the first direction if it was found in a restart file. - if (CS%first_dir_restart > -0.5) & - call set_first_direction(G, NINT(CS%first_dir_restart)) - ! Store the first direction for the next time a restart file is written. - CS%first_dir_restart = real(G%first_direction) + ! Reset the first direction if it was found in a restart file + if (CS%first_dir_restart > -1.0) then + call set_first_direction(G, modulo(NINT(CS%first_dir_restart) + turns, 2)) + else + CS%first_dir_restart = real(modulo(first_direction, 2)) + endif call rotate_initial_state(u_in, v_in, h_in, T_in, S_in, use_temperature, & turns, CS%u, CS%v, CS%h, CS%T, CS%S) @@ -2516,6 +2522,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp, CS%oda_incupd_CSp, CS%OBC, Time_in) endif + + ! Reset the first direction if it was found in a restart file. + if (CS%first_dir_restart > -1.0) then + call set_first_direction(G, NINT(CS%first_dir_restart)) + else + CS%first_dir_restart = real(modulo(first_direction, 2)) + endif endif if (use_ice_shelf .and. CS%debug) & From e218478b9aca181aca9e910299b2107099aa6b52 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Nov 2021 13:02:27 -0500 Subject: [PATCH 080/138] Expanded comments describing src/core code (#13) Added comments describing all of the real variables in the src/core directory that did not previously have them, and corrected multiple spelling error in this same directory. This PR also updates the description of the MOM6 code structure in MOM.F90 and adds dimensional descriptions to the commends describing a number of variables. Descriptions of the units of some variables were also added or corrected in a number of the src/tracer files. Changes are largely restricted to comments describing varibles, although a few unused variables were removed. One comment added to MOM_dynamics_split_RK2.F90 notes a possible memory leak, due to a missing deallocate call, but the actual correction of this leak will be delayed to a later, much more targeted commit. All answers and output are bitwise identical. --- src/core/MOM.F90 | 128 +++++++++++------ src/core/MOM_CoriolisAdv.F90 | 42 +++--- src/core/MOM_PressureForce_FV.F90 | 8 +- src/core/MOM_PressureForce_Montgomery.F90 | 4 +- src/core/MOM_barotropic.F90 | 130 ++++++++++-------- src/core/MOM_continuity_PPM.F90 | 94 +++++++------ src/core/MOM_density_integrals.F90 | 14 +- src/core/MOM_dynamics_split_RK2.F90 | 107 +++++++------- src/core/MOM_dynamics_unsplit.F90 | 12 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 15 +- src/core/MOM_forcing_type.F90 | 65 ++++----- src/core/MOM_grid.F90 | 18 +-- src/core/MOM_interface_heights.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 10 +- src/core/MOM_open_boundary.F90 | 109 +++++++-------- src/core/MOM_verticalGrid.F90 | 2 +- src/tracer/MOM_CFC_cap.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_lateral_boundary_diffusion.F90 | 81 ++++++----- src/tracer/MOM_neutral_diffusion.F90 | 7 +- src/tracer/MOM_offline_aux.F90 | 4 +- src/tracer/MOM_tracer_diabatic.F90 | 51 +++---- src/tracer/MOM_tracer_registry.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 4 +- 29 files changed, 498 insertions(+), 425 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f3a2dff337..90c3d7bef2 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -168,7 +168,7 @@ module MOM !>@{ 3-d state field diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 !>@} - !> 2-d state field diagnotic ID + !> 2-d state field diagnostic ID integer :: id_ssh_inst = -1 end type MOM_diag_IDs @@ -249,7 +249,7 @@ module MOM real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. - integer :: nstep_tot = 0 !< The total number of dynamic timesteps tcaaken + integer :: nstep_tot = 0 !< The total number of dynamic timesteps taken !! so far in this run segment logical :: count_calls = .false. !< If true, count the calls to step_MOM, rather than the !! number of dynamics steps in nstep_tot @@ -330,7 +330,7 @@ module MOM real :: bad_val_col_thick !< Minimum column thickness before triggering bad value message [Z ~> m] logical :: answers_2018 !< If true, use expressions for the surface properties that recover !! the answers from the end of 2018. Otherwise, use more appropriate - !! expressions that differ at roundoff for non-Boussinsq cases. + !! expressions that differ at roundoff for non-Boussinesq cases. logical :: use_particles !< Turns on the particles package character(len=10) :: particle_type !< Particle types include: surface(default), profiling and sail drone. @@ -493,7 +493,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS real :: dt_therm ! a limited and quantized version of CS%dt_therm [T ~> s] real :: dt_therm_here ! a further limited value of dt_therm [T ~> s] - real :: wt_end, wt_beg + real :: wt_end, wt_beg ! Fractional weights of the future pressure at the end + ! and beginning of the current time step [nondim] real :: bbl_time_int ! The amount of time over which the calculated BBL ! properties will apply, for use in diagnostics, or 0 ! if it is not to be calculated anew [T ~> s]. @@ -1517,12 +1518,12 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! 3D pointers real, dimension(:,:,:), pointer :: & - uhtr => NULL(), vhtr => NULL(), & - eatr => NULL(), ebtr => NULL(), & - h_end => NULL() + uhtr => NULL(), & ! Accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] + vhtr => NULL(), & ! Accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] + eatr => NULL(), & ! Layer entrainment rates across the interface above [H ~> m or kg m-2] + ebtr => NULL(), & ! Layer entrainment rates across the interface below [H ~> m or kg m-2] + h_end => NULL() ! Layer thicknesses at the end of a step [H ~> m or kg m-2] - ! 2D Array for diagnostics - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end type(time_type) :: Time_end ! End time of a segment, as a time type ! Grid-related pointer assignments @@ -1719,9 +1720,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: turns ! Number of grid quarter-turns ! Initial state on the input index map - real, allocatable, dimension(:,:,:) :: u_in, v_in, h_in - real, allocatable, dimension(:,:), target :: frac_shelf_in - real, allocatable, dimension(:,:,:), target :: T_in, S_in + real, allocatable :: u_in(:,:,:) ! Initial zonal velocities [L T-1 ~> m s-1] + real, allocatable :: v_in(:,:,:) ! Initial meridional velocities [L T-1 ~> m s-1] + real, allocatable :: h_in(:,:,:) ! Initial layer thicknesses [H ~> m or kg m-2] + real, allocatable, target :: frac_shelf_in(:,:) ! Initial fraction of the total cell area occupied + ! by an ice shelf [nondim] + real, allocatable, target :: T_in(:,:,:) ! Initial temperatures [degC] + real, allocatable, target :: S_in(:,:,:) ! Initial salinities [ppt] type(ocean_OBC_type), pointer :: OBC_in => NULL() type(sponge_CS), pointer :: sponge_in_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_in_CSp => NULL() @@ -1754,7 +1759,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: bulkmixedlayer ! If true, a refined bulk mixed layer scheme is used ! with nkml sublayers and nkbl buffer layer. - logical :: use_temperature ! If true, temp and saln used as state variables. + logical :: use_temperature ! If true, temperature and salinity used as state variables. logical :: use_frazil ! If true, liquid seawater freezes if temp below freezing, ! with accumulated heat deficit returned to surface ocean. logical :: bound_salinity ! If true, salt is added to keep salinity above @@ -1781,7 +1786,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt, conv2salt + real :: conv2watt ! A conversion factor from temperature fluxes to heat + ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] + real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors character(len=48) :: flux_units, S_flux_units @@ -2178,7 +2185,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%G => G_in endif - ! TODO: It is unlikey that test_grid_copy and rotate_index would work at the + ! TODO: It is unlikely that test_grid_copy and rotate_index would work at the ! same time. It may be possible to enable both but for now we prevent it. if (test_grid_copy .and. CS%rotate_index) & call MOM_error(FATAL, "Grid cannot be copied during index rotation.") @@ -2218,7 +2225,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call rotate_hor_index(HI_in, turns, HI) ! NOTE: If indices are rotated, then G and G_in must both be initialized separately, and ! the dynamic grid must be created to handle the grid rotation. G%domain has already been - ! initialzed above. + ! initialized above. call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) call create_dyn_horgrid(dG, HI, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(G%Domain, dG%Domain) @@ -3142,7 +3149,7 @@ subroutine extract_surface_state(CS, sfc_state_in) !! calculation of properties of the uppermost ocean [nondim] or [Z H-1 ~> 1 or m3 kg-1] ! After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1. real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [Z degC ~> m degC] - logical :: use_temperature !< If true, temp and saln used as state variables. + logical :: use_temperature !< If true, temperature and salinity are used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg integer :: isd, ied, jsd, jed integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB @@ -3528,10 +3535,18 @@ end subroutine extract_surface_state !> Rotate initialization fields from input to rotated arrays. subroutine rotate_initial_state(u_in, v_in, h_in, T_in, S_in, & use_temperature, turns, u, v, h, T, S) - real, dimension(:,:,:), intent(in) :: u_in, v_in, h_in, T_in, S_in - logical, intent(in) :: use_temperature - integer, intent(in) :: turns - real, dimension(:,:,:), intent(out) :: u, v, h, T, S + real, dimension(:,:,:), intent(in) :: u_in !< Zonal velocity on the initial grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(in) :: v_in !< Meridional velocity on the initial grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(in) :: h_in !< Layer thickness on the initial grid [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: T_in !< Temperature on the initial grid [degC] + real, dimension(:,:,:), intent(in) :: S_in !< Salinity on the initial grid [ppt] + logical, intent(in) :: use_temperature !< If true, temperature and salinity are active + integer, intent(in) :: turns !< The number quarter-turns to apply + real, dimension(:,:,:), intent(out) :: u !< Zonal velocity on the rotated grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(out) :: v !< Meridional velocity on the rotated grid [L T-1 ~> m s-1] + real, dimension(:,:,:), intent(out) :: h !< Layer thickness on the rotated grid [H ~> m or kg m-2] + real, dimension(:,:,:), intent(out) :: T !< Temperature on the rotated grid [degC] + real, dimension(:,:,:), intent(out) :: S !< Salinity on the rotated grid [ppt] call rotate_vector(u_in, v_in, turns, u, v) call rotate_array(h_in, turns, h) @@ -3852,29 +3867,48 @@ end subroutine MOM_end !! !! \verbatim !! ../MOM +!! |-- ac !! |-- config_src -!! | |-- coupled_driver -!! | |-- dynamic -!! | `-- solo_driver -!! |-- examples -!! | |-- CM2G +!! | |-- drivers +!! | ! |-- FMS_cap +!! | ! |-- ice_solo_driver +!! | ! |-- mct_cap +!! | ! |-- nuopc_cap +!! | ! |-- solo_driver +!! | ! `-- unit_drivers +!! | |-- external +!! | ! |-- drifters +!! | ! |-- GFDL_ocean_BGC +!! | ! `-- ODA_hooks +!! | |-- infra +!! | ! |-- FMS1 +!! | ! `-- FMS2 +!! | `-- memory +!! | ! |-- dynamic_nonsymmetric +!! | ! `-- dynamic_symmetric +!! |-- docs +!! |-- pkg +!! | |-- CVMix-src !! | |-- ... -!! | `-- torus_advection_test +!! | `-- MOM6_DA_hooks !! `-- src +!! |-- ALE !! |-- core !! |-- diagnostics !! |-- equation_of_state !! |-- framework !! |-- ice_shelf !! |-- initialization +!! |-- ocean_data_assim !! |-- parameterizations +!! | |-- CVMix !! | |-- lateral !! | `-- vertical !! |-- tracer !! `-- user !! \endverbatim !! -!! Rather than describing each file here, each directory contents +!! Rather than describing each file here, selected directory contents !! will be described to give a broad overview of the MOM code !! structure. !! @@ -3883,27 +3917,35 @@ end subroutine MOM_end !! Only one or two of these directories are used in compiling any, !! particular run. !! -!! * config_src/coupled_driver: +!! * config_src/drivers/FMS-cap: !! The files here are used to couple MOM as a component in a larger !! run driven by the FMS coupler. This includes code that converts !! various forcing fields into the code structures and flux and unit !! conventions used by MOM, and converts the MOM surface fields !! back to the forms used by other FMS components. !! -!! * config_src/dynamic: -!! The only file here is the version of MOM_memory.h that is used -!! for dynamic memory configurations of MOM. +!! * config_src/drivers/nuopc-cap: +!! The files here are used to couple MOM as a component in a larger +!! run driven by the NUOPC coupler. This includes code that converts +!! various forcing fields into the code structures and flux and unit +!! conventions used by MOM, and converts the MOM surface fields +!! back to the forms used by other NUOPC components. !! -!! * config_src/solo_driver: +!! * config_src/drivers/solo_driver: !! The files here are include the _main driver that is used when !! MOM is configured as an ocean-only model, as well as the files !! that specify the surface forcing in this configuration. !! -!! The directories under examples provide a large number of working -!! configurations of MOM, along with reference solutions for several -!! different compilers on GFDL's latest large computer. The versions -!! of MOM_memory.h in these directories need not be used if dynamic -!! memory allocation is desired, and the answers should be unchanged. +!! * config_src/external: +!! The files here are mostly just stubs, so that MOM6 can compile +!! with calls to the public interfaces external packages, but +!! without actually requiring those packages themselves. In more +!! elaborate configurations, would be linked to the actual code for +!! those external packages rather than these simple stubs. +!! +!! * config_src/memory/dynamic-symmetric: +!! The only file here is the version of MOM_memory.h that is used +!! for dynamic memory configurations of MOM. !! !! The directories under src contain most of the MOM files. These !! files are used in every configuration using MOM. @@ -3916,7 +3958,7 @@ end subroutine MOM_end !! subroutine argument lists. !! !! * src/diagnostics: -!! The files here calculate various diagnostics that are anciliary +!! The files here calculate various diagnostics that are ancilliary !! to the model itself. While most of these diagnostics do not !! directly affect the model's solution, there are some, like the !! calculation of the deformation radius, that are used in some @@ -3973,13 +4015,19 @@ end subroutine MOM_end !! to build an appropriate makefile, and path_names should be edited !! to reflect the actual location of the desired source code. !! +!! The separate MOM-examples git repository provides a large number +!! of working configurations of MOM, along with reference solutions for several +!! different compilers on GFDL's latest large computer. The versions +!! of MOM_memory.h in these directories need not be used if dynamic +!! memory allocation is desired, and the answers should be unchanged. +!! !! !! There are 3 publicly visible subroutines in this file (MOM.F90). !! * step_MOM steps MOM over a specified interval of time. !! * MOM_initialize calls initialize and does other initialization !! that does not warrant user modification. !! * extract_surface_state determines the surface (bulk mixed layer -!! if traditional isoycnal vertical coordinate) properties of the +!! if traditional isopycnal vertical coordinate) properties of the !! current model state and packages pointers to these fields into an !! exported structure. !! diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 93dda759c2..953d64c1f0 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -163,7 +163,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas [H L2 ~> m3 or kg]. - KEy, & ! The meridonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], + KEy, & ! The meridional gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEy = d/dy KE. vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -204,17 +204,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uhm, vhm ! The input estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme. + real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme [nondim] - real :: Fe_m2 ! Nondimensional temporary variables asssociated with - real :: rat_lin ! the ARAKAWA_LAMB_BLEND scheme. + real :: Fe_m2 ! Temporary variable associated with the ARAKAWA_LAMB_BLEND scheme [nondim] + real :: rat_lin ! Temporary variable associated with the ARAKAWA_LAMB_BLEND scheme [nondim] real :: rat_m1 ! The ratio of the maximum neighboring inverse thickness - ! to the minimum inverse thickness minus 1. rat_m1 >= 0. + ! to the minimum inverse thickness minus 1 [nondim]. rat_m1 >= 0. real :: AL_wt ! The relative weight of the Arakawa & Lamb scheme to the - ! Arakawa & Hsu scheme, nondimensional between 0 and 1. + ! Arakawa & Hsu scheme [nondim], between 0 and 1. real :: Sad_wt ! The relative weight of the Sadourny energy scheme to - ! the other two with the ARAKAWA_LAMB_BLEND scheme, - ! nondimensional between 0 and 1. + ! the other two with the ARAKAWA_LAMB_BLEND scheme [nondim], + ! between 0 and 1. real :: Heff1, Heff2 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: Heff3, Heff4 ! Temporary effective H at U or V points [H ~> m or kg m-2]. @@ -232,7 +232,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) ! hf_gKEu, hf_gKEv, & ! accel. due to KE gradient x fract. thickness [L T-2 ~> m s-2]. ! hf_rvxu, hf_rvxv ! accel. due to RV x fract. thickness [L T-2 ~> m s-2]. ! 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. + ! The code is retained for debugging purposes in the future. ! Diagnostics for thickness multiplied momentum budget terms real, allocatable, dimension(:,:,:) :: h_gKEu, h_gKEv ! h x gKEu, h x gKEv [H L T-2 ~> m2 s-2]. @@ -676,7 +676,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) endif enddo ; enddo endif - ! Add in the additonal terms with Arakawa & Lamb. + ! Add in the additional terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = CAu(I,j,k) + & @@ -876,7 +876,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) ! Diagnostics for terms multiplied by fractional thicknesses ! 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. + ! The code is retained for debugging purposes in the future. !if (CS%id_hf_gKEu > 0) then ! 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 @@ -1025,7 +1025,7 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. 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(ocean_grid_type), intent(in) :: G !< Ocean 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] @@ -1061,7 +1061,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) )*0.25*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then - ! The following discretization of KE is based on the one-dimensinal Gudonov + ! The following discretization of KE is based on the one-dimensional Gudonov ! scheme which does not take into account any geometric factors do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2 = up*up @@ -1071,7 +1071,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) KE(i,j) = ( max(up2,um2) + max(vp2,vm2) ) *0.5 enddo ; enddo elseif (CS%KE_Scheme == KE_GUDONOV) then - ! The following discretization of KE is based on the one-dimensinal Gudonov + ! The following discretization of KE is based on the one-dimensional Gudonov ! scheme but has been adapted to take horizontal grid factors into account do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*G%areaCu(I-1,j) @@ -1108,16 +1108,16 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) end subroutine gradKE -!> Initializes the control structure for coriolisadv_cs +!> Initializes the control structure for MOM_CoriolisAdv subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(accel_diag_ptrs), target, intent(inout) :: AD !< Strorage for acceleration diagnostics - type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure fro MOM_CoriolisAdv + type(accel_diag_ptrs), target, intent(inout) :: AD !< Storage for acceleration diagnostics + type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1405,7 +1405,7 @@ end subroutine CoriolisAdv_init !> Destructor for coriolisadv_cs subroutine CoriolisAdv_end(CS) - type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure fro MOM_CoriolisAdv + type(CoriolisAdv_CS), intent(inout) :: CS !< Control structure for MOM_CoriolisAdv end subroutine CoriolisAdv_end !> \namespace mom_coriolisadv diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 8436b92f80..5ead019717 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -199,7 +199,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are - ! lighter than the the buffer layer with the properties of the buffer + ! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. if (nkmb>0) then @@ -230,7 +230,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! If regridding is activated, do a linear reconstruction of salinity ! and temperature across each layer. The subscripts 't' and 'b' refer ! to top and bottom values within each layer (these are the only degrees - ! of freedeom needed to know the linear profile). + ! of freedom needed to know the linear profile). if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then call TS_PLM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) @@ -595,7 +595,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are -! lighter than the the buffer layer with the properties of the buffer +! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. @@ -654,7 +654,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! If regridding is activated, do a linear reconstruction of salinity ! and temperature across each layer. The subscripts 't' and 'b' refer ! to top and bottom values within each layer (these are the only degrees - ! of freedeom needed to know the linear profile). + ! of freedom needed to know the linear profile). if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then call TS_PLM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 6a0831eca9..a827fb12d0 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -219,7 +219,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Calculate in-situ specific volumes (alpha_star). ! With a bulk mixed layer, replace the T & S of any layers that are - ! lighter than the the buffer layer with the properties of the buffer + ! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. if (nkmb>0) then @@ -475,7 +475,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! Calculate in-situ densities (rho_star). ! With a bulk mixed layer, replace the T & S of any layers that are -! lighter than the the buffer layer with the properties of the buffer +! lighter than the buffer layer with the properties of the buffer ! layer. These layers will be massless anyway, and it avoids any ! formal calculations with hydrostatically unstable profiles. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index ca1a7d20e5..a7e8194a84 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1,4 +1,4 @@ -!> Baropotric solver +!> Barotropic solver module MOM_barotropic ! This file is part of MOM6. See LICENSE.md for the license. @@ -98,7 +98,7 @@ module MOM_barotropic type(group_pass_type) :: pass_eta_outer !< Structure for group halo pass end type BT_OBC_type -!> The barotropic stepping control stucture +!> The barotropic stepping control structure type, public :: barotropic_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: frhatu !< The fraction of the total column thickness interpolated to u grid points in each layer [nondim]. @@ -132,8 +132,8 @@ module MOM_barotropic !< A limit on the rate at which eta_cor can be applied while avoiding instability !! [H T-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & - ua_polarity, & !< Test vector components for checking grid polarity. - va_polarity, & !< Test vector components for checking grid polarity. + ua_polarity, & !< Test vector components for checking grid polarity [nondim] + va_polarity, & !< Test vector components for checking grid polarity [nondim] bathyT !< A copy of bathyT (ocean bottom depth) with wide halos [Z ~> m] real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will @@ -149,15 +149,15 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & q_D !< f / D at PV points [Z-1 T-1 ~> m-1 s-1]. - real, allocatable :: frhatu1(:,:,:) !< Predictor step values of frhatu stored for diagnostics. - real, allocatable :: frhatv1(:,:,:) !< Predictor step values of frhatv stored for diagnostics. + real, allocatable :: frhatu1(:,:,:) !< Predictor step values of frhatu stored for diagnostics [nondim] + real, allocatable :: frhatv1(:,:,:) !< Predictor step values of frhatv stored for diagnostics [nondim] type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields !! for applying open boundary conditions. real :: dtbt !< The barotropic time step [T ~> s]. real :: dtbt_fraction !< The fraction of the maximum time-step that - !! should used. The default is 0.98. + !! should used [nondim]. The default is 0.98. real :: dtbt_max !< The maximum stable barotropic time step [T ~> s]. real :: dt_bt_filter !< The time-scale over which the barotropic mode solutions are !! filtered [T ~> s] if positive, or as a fraction of DT if @@ -166,7 +166,7 @@ module MOM_barotropic integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic !! time step the last time btstep was called. real :: bebt !< A nondimensional number, from 0 to 1, that - !! determines the gravity wave time stepping scheme. + !! determines the gravity wave time stepping scheme [nondim]. !! 0.0 gives a forward-backward scheme, while 1.0 !! give backward Euler. In practice, bebt should be !! of order 0.2 or greater. @@ -209,7 +209,7 @@ module MOM_barotropic !! barotropic step when calculating the surface stress contribution to !! the barotropic acclerations. Otherwise use the depth based on bathyT. real :: BT_Coriolis_scale !< A factor by which the barotropic Coriolis acceleration anomaly - !! terms are scaled. + !! terms are scaled [nondim]. logical :: answers_2018 !< If true, use expressions for the barotropic solver that recover !! the answers from the end of 2018. Otherwise, use more efficient !! or general expressions. @@ -228,7 +228,7 @@ module MOM_barotropic logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the !! barotropic solver has the wrong sign, replicating a long-standing !! bug. - real :: G_extra !< A nondimensional factor by which gtot is enhanced. + real :: G_extra !< A nondimensional factor by which gtot is enhanced [nondim]. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are !! given by the parameters defined below: @@ -255,10 +255,10 @@ module MOM_barotropic !! truncated to maxvel [L T-1 ~> m s-1]. real :: CFL_trunc !< If clip_velocity is true, velocity components will !! be truncated when they are large enough that the - !! corresponding CFL number exceeds this value, nondim. + !! corresponding CFL number exceeds this value [nondim]. real :: maxCFL_BT_cont !< The maximum permitted CFL number associated with the !! barotropic accelerations from the summed velocities - !! times the time-derivatives of thicknesses. The + !! times the time-derivatives of thicknesses [nondim]. The !! default is 0.1, and there will probably be real !! problems if this were set close to 1. logical :: BT_cont_bounds !< If true, use the BT_cont_type variables to set limits @@ -321,7 +321,7 @@ module MOM_barotropic end type barotropic_CS -!> A desciption of the functional dependence of transport at a u-point +!> A description of the functional dependence of transport at a u-point type, private :: local_BT_cont_u_type real :: FA_u_EE !< The effective open face area for zonal barotropic transport !! drawing from locations far to the east [H L ~> m2 or kg m-1]. @@ -347,7 +347,7 @@ module MOM_barotropic !! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg]. end type local_BT_cont_u_type -!> A desciption of the functional dependence of transport at a v-point +!> A description of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type real :: FA_v_NN !< The effective open face area for meridional barotropic transport !! drawing from locations far to the north [H L ~> m2 or kg m-1]. @@ -451,13 +451,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure 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). + !! viscosity is applied, in the zonal direction [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above). real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim]. type(accel_diag_ptrs), pointer :: ADp !< Acceleration diagnostic pointers type(ocean_OBC_type), pointer :: OBC !< The open boundary condition structure. @@ -489,19 +489,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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. + ! sums less than one due to viscous losses [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & - av_rem_u, & ! The weighted average of visc_rem_u, nondimensional. - tmp_u, & ! A temporary array at u points. + av_rem_u, & ! The weighted average of visc_rem_u [nondim] + tmp_u, & ! A temporary array at u points [L T-2 ~> m s-2] or [nondim] ubt_st, & ! The zonal barotropic velocity at the start of timestep [L T-1 ~> m s-1]. ubt_dt ! The zonal barotropic velocity tendency [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G)) :: & - av_rem_v, & ! The weighted average of visc_rem_v, nondimensional. - tmp_v, & ! A temporary array at v points. + av_rem_v, & ! The weighted average of visc_rem_v [nondim] + tmp_v, & ! A temporary array at v points [L T-2 ~> m s-2] or [nondim] vbt_st, & ! The meridional barotropic velocity at the start of timestep [L T-1 ~> m s-1]. vbt_dt ! The meridional barotropic velocity tendency [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - tmp_h, & ! A temporary array at h points. + tmp_h, & ! A temporary array at h points [nondim] e_anom ! The anomaly in the sea surface height or column mass ! averaged between the beginning and end of the time step, ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2]. @@ -512,8 +512,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIBW_(CS),SZJW_(CS)) :: & ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1]. bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains - ! after a time step, the remainder being lost to bottom drag. - ! bt_rem_u is a nondimensional number between 0 and 1. + ! after a time step, the remainder being lost to bottom drag [nondim]. + ! bt_rem_u is between 0 and 1. BT_force_u, & ! The vertical average of all of the u-accelerations that are ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. u_accel_bt, & ! The difference between the zonal acceleration from the @@ -530,8 +530,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, uhbt_int, & ! The running time integral of uhbt over the time steps [H L2 ~> m3]. ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1]. ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1]. - azon, bzon, & ! _zon & _mer are the values of the Coriolis force which - czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav, + azon, bzon, & ! _zon and _mer are the values of the Coriolis force which + czon, dzon, & ! are applied to the neighboring values of vbtav and ubtav, amer, bmer, & ! respectively to get the barotropic inertial rotation cmer, dmer, & ! [T-1 ~> s-1]. Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2]. @@ -548,7 +548,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1]. bt_rem_v, & ! The fraction of the barotropic meridional velocity that ! remains after a time step, the rest being lost to bottom - ! drag. bt_rem_v is a nondimensional number between 0 and 1. + ! drag [nondim]. bt_rem_v is between 0 and 1. BT_force_v, & ! The vertical average of all of the v-accelerations that are ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. v_accel_bt, & ! The difference between the meridional acceleration from the @@ -635,9 +635,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! of the reference geopotential with the sea surface height [nondim]. ! This is typically ~0.09 or less. real :: dgeo_de ! The constant of proportionality between geopotential and - ! sea surface height [nondim]. It is a nondimensional number of - ! order 1. For stability, this may be made larger - ! than the physical problem would suggest. + ! sea surface height [nondim]. It is of order 1, but for + ! stability this may be made larger than the physical + ! problem would suggest. real :: Instep ! The inverse of the number of barotropic time steps to take [nondim]. real :: wt_end ! The weighting of the final value of eta_PF [nondim] integer :: nstep ! The number of barotropic time steps to take. @@ -673,9 +673,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1] - real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 - real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans - real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans + real, allocatable :: wt_vel(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average velocities [nondim] + real, allocatable :: wt_eta(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average the average of eta [nondim] + real, allocatable :: wt_accel(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average accelerations [nondim] + real, allocatable :: wt_trans(:) ! The raw or relative weights of each of the barotropic timesteps + ! in determining the average transports [nondim] + real, allocatable :: wt_accel2(:) ! A potentially un-normalized copy of wt_accel [nondim] + real :: sum_wt_vel ! The sum of the raw weights used to find average velocities [nondim] + real :: sum_wt_eta ! The sum of the raw weights used to find average the average of eta [nondim] + real :: sum_wt_accel ! The sum of the raw weights used to find average accelerations [nondim] + real :: sum_wt_trans ! The sum of the raw weights used to find average transports [nondim] + real :: I_sum_wt_vel ! The inverse of the sum of the raw weights used to find average velocities [nondim] + real :: I_sum_wt_eta ! The inverse of the sum of the raw weights used to find the average of eta [nondim] + real :: I_sum_wt_accel ! The inverse of the sum of the raw weights used to find average accelerations [nondim] + real :: I_sum_wt_trans ! The inverse of the sum of the raw weights used to find average transports [nondim] real :: dt_filt ! The half-width of the barotropic filter [T ~> s]. real :: trans_wt1, trans_wt2 ! The weights used to compute ubt_trans and vbt_trans integer :: nfilter @@ -2914,13 +2928,9 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1] real :: uhbt_int_new ! The updated time-integrated zonal transport [H L2 ~> m3] real :: vhbt_int_new ! The updated time-integrated meridional transport [H L2 ~> m3] - real :: h_in ! The inflow thickess [H ~> m or kg m-2]. - real :: cff, Cx, Cy, tau - real :: dhdt, dhdx, dhdy + real :: h_in ! The inflow thickness [H ~> m or kg m-2]. real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1] integer :: i, j, is, ie, js, je - real, dimension(SZIB_(G),SZJB_(G)) :: grad - real, parameter :: eps = 1.0e-20 is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo if (.not.(BT_OBC%apply_u_OBCs .or. BT_OBC%apply_v_OBCs)) return @@ -3262,7 +3272,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -3284,7 +3294,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) real :: h_harm ! The harmonic mean thicknesses [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 :: wt_arith ! The nondimensional weight for the arithmetic mean thickness. + real :: wt_arith ! The weight for the arithmetic mean thickness [nondim]. ! The harmonic mean uses a weight of (1 - wt_arith). real :: Rh ! A ratio of summed thicknesses, nondim. real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity and @@ -3606,7 +3616,7 @@ function uhbt_to_ubt(uhbt, BTC) result(ubt) real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the - ! maximum increase of vs2, both nondim. + ! maximum increase of vs2, both [nondim]. integer :: itt, max_itt = 20 ! Find the value of ubt that gives uhbt. @@ -3741,7 +3751,7 @@ function vhbt_to_vbt(vhbt, BTC) result(vbt) real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the - ! maximum increase of vs2, both nondim. + ! maximum increase of vs2, both [nondim]. integer :: itt, max_itt = 20 ! Find the value of vbt that gives vhbt. @@ -3937,7 +3947,7 @@ end subroutine set_local_BT_cont_types !> Adjust_local_BT_cont_types expands the range of velocities with a cubic curve -!! translating velocities into transports to match the inital values of velocities and +!! translating velocities into transports to match the initial values of velocities and !! summed transports when the velocities are larger than the first guesses of the cubic !! transition velocities used to set up the local_BT_cont types. subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & @@ -3964,10 +3974,6 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & !! provided if INTEGRAL_BT_CONTINUITY is true. ! Local variables - real, dimension(SZIBW_(MS),SZJW_(MS)) :: & - u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW - real, dimension(SZIW_(MS),SZJBW_(MS)) :: & - v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim] real, parameter :: C1_3 = 1.0/3.0 integer :: i, j, is, ie, js, je, hs @@ -4072,9 +4078,9 @@ end subroutine BT_cont_to_face_areas !> Swap the values of two real variables subroutine swap(a,b) - real, intent(inout) :: a !< The first variable to be swapped. - real, intent(inout) :: b !< The second variable to be swapped. - real :: tmp + real, intent(inout) :: a !< The first variable to be swapped [arbitrary units] + real, intent(inout) :: b !< The second variable to be swapped [arbitrary units] + real :: tmp ! A temporary variable [arbitrary units] tmp = a ; a = b ; b = tmp end subroutine swap @@ -4089,7 +4095,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(barotropic_CS), intent(in) :: CS !< Barotropic control struct + type(barotropic_CS), intent(in) :: CS !< Barotropic control structure integer, intent(in) :: halo !< The halo size to use, default = 1. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & optional, intent(in) :: eta !< The barotropic free surface height anomaly @@ -4183,7 +4189,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) !! fluxes (and update the slowly varying part of eta_cor) !! (.true.) or whether to incrementally update the !! corrective fluxes. - type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure ! Local variables real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses [H ~> m or kg m-2]. @@ -4249,8 +4255,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must !! be recalculated before stepping. type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the @@ -4259,8 +4265,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(tidal_forcing_CS), target, optional :: tides_CSp !< A pointer to the control structure of the !! tide module. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1]. @@ -4286,7 +4292,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real :: det_de ! The partial derivative due to self-attraction and loading of the reference ! geopotential with the sea surface height when tides are enabled. ! This is typically ~0.09 or less. - real, allocatable, dimension(:,:) :: lin_drag_h + real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points + ! that acts on the barotropic flow [Z T-1 ~> m s-1]. + type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity @@ -4958,7 +4966,7 @@ end subroutine barotropic_init !> Copies ubtav and vbtav from private type into arrays subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) - type(barotropic_CS), intent(in) :: CS !< Barotropic control struct + type(barotropic_CS), intent(in) :: CS !< Barotropic control structure type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged !! over a baroclinic timestep [L T-1 ~> m s-1] @@ -5007,9 +5015,9 @@ end subroutine barotropic_end subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(barotropic_CS), intent(inout) :: CS !< Barotropic control struct + type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! Local variables type(vardesc) :: vd(3) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index eca822ac6b..90e1086bc5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -106,15 +106,15 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhb !< 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). + !! a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above the bottom). 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). + !! a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_v is between 0 (at the bottom) and 1 (far above the bottom). 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]. @@ -239,11 +239,11 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are 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). + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor - !< The zonal velocitiess (u with a barotropic correction) + !< The zonal velocities (u with a barotropic correction) !! that give uhbt as the depth-integrated transport, 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. @@ -254,13 +254,13 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are 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 - du_max_CFL, & ! to avoid CFL violations + du_max_CFL, & ! to avoid CFL violations [L T-1 ~> m s-1] duhdu_tot_0, & ! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. 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. + visc_rem_max ! The column maximum of visc_rem [nondim]. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(GV)) :: & - visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. + visc_rem ! A 2-D copy of visc_rem_u or an array of 1's [nondim]. 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 L ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. @@ -533,8 +533,8 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the 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). + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness [H ~> m or kg m-2]. @@ -635,8 +635,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, 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 - !! barotropic acceleration that a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! barotropic acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_u is between 0 (at the bottom) and 1 (far above the bottom). ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -665,7 +665,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, 3.0*curv_3*(CFL - 1.0)) else h_avg = 0.5 * (h_L(i+1,j,k) + h_R(i,j,k)) - ! The choice to use the arithmetic mean here is somewhat arbitrariy, but + ! The choice to use the arithmetic mean here is somewhat arbitrarily, but ! it should be noted that h_L(i+1,j,k) and h_R(i,j,k) are usually the same. h_marg = 0.5 * (h_L(i+1,j,k) + h_R(i,j,k)) ! h_marg = (2.0 * h_L(i+1,j,k) * h_R(i,j,k)) / & @@ -733,8 +733,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & 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. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< The summed volume flux !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -898,9 +898,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, 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. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem. + !! experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZIB_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem [nondim]. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -929,7 +929,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m]. real :: FA_avg ! The average effective face area [L H ~> m2 or kg m], nominally given by ! the realized transport divided by the barotropic velocity. - real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This + real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim]. This ! limiting is necessary to keep the inverse of visc_rem ! from leading to large CFL numbers. real :: min_visc_rem ! The smallest permitted value for visc_rem that is used @@ -1059,11 +1059,11 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac 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. Nondimensional between - !! 0 (at the bottom) and 1 (far above the bottom). + !! that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_v is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(out) :: v_cor - !< The meridional velocitiess (v with a barotropic correction) + !< The meridional velocities (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. @@ -1349,8 +1349,8 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the 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). + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the reconstruction @@ -1456,8 +1456,8 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, 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. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem_v is between 0 (at the bottom) and 1 (far above the bottom). ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -1487,7 +1487,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, 3.0*curv_3*(CFL - 1.0)) else h_avg = 0.5 * (h_L(i,j+1,k) + h_R(i,j,k)) - ! The choice to use the arithmetic mean here is somewhat arbitrariy, but + ! The choice to use the arithmetic mean here is somewhat arbitrarily, but ! it should be noted that h_L(i+1,j,k) and h_R(i,j,k) are usually the same. h_marg = 0.5 * (h_L(i,j+1,k) + h_R(i,j,k)) ! h_marg = (2.0 * h_L(i,j+1,k) * h_R(i,j,k)) / & @@ -1556,8 +1556,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !< 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. Non-dimensional - !! between 0 (at the bottom) and 1 (far above the bottom). + !! a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -1719,9 +1719,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, 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. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem. + !! acceleration that a layer experiences after viscosity is applied [nondim]. + !! Visc_rem is between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G)), intent(in) :: visc_rem_max !< Maximum allowable visc_rem [nondim] integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1755,7 +1755,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! from leading to large CFL numbers. real :: min_visc_rem ! The smallest permitted value for visc_rem that is used ! in finding the barotropic velocity that changes the - ! flow direction. This is necessary to keep the inverse + ! flow direction [nondim]. This is necessary to keep the inverse ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] @@ -1876,8 +1876,9 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. real, parameter :: oneSixth = 1./6. - real :: h_ip1, h_im1 - real :: dMx, dMn + real :: h_ip1, h_im1 ! Neighboring thicknesses or sensibly extrapolated values [H ~> m or kg m-2] + real :: dMx, dMn ! The difference between the local thickness and the maximum (dMx) or + ! minimum (dMn) of the surrounding values [H ~> m or kg m-2] character(len=256) :: mesg integer :: i, j, isl, iel, jsl, jel, n, stencil logical :: local_open_BC @@ -2011,8 +2012,9 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. real, parameter :: oneSixth = 1./6. - real :: h_jp1, h_jm1 - real :: dMx, dMn + real :: h_jp1, h_jm1 ! Neighboring thicknesses or sensibly extrapolated values [H ~> m or kg m-2] + real :: dMx, dMn ! The difference between the local thickness and the maximum (dMx) or + ! minimum (dMn) of the surrounding values [H ~> m or kg m-2] character(len=256) :: mesg integer :: i, j, isl, iel, jsl, jel, n, stencil logical :: local_open_BC @@ -2139,8 +2141,9 @@ subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) integer, intent(in) :: jie !< End of j index range. ! Local variables - real :: curv, dh, scale - character(len=256) :: mesg + real :: curv ! The grid-normalized curvature of the three thicknesses [H ~> m or kg m-2] + real :: dh ! The difference between the edge thicknesses [H ~> m or kg m-2] + real :: scale ! A scaling factor to reduce the curvature of the fit [nondim] integer :: i,j do j=jis,jie ; do i=iis,iie @@ -2180,9 +2183,12 @@ subroutine PPM_limit_CW84(h_in, h_L, h_R, G, iis, iie, jis, jie) integer, intent(in) :: jie !< End of j index range. ! Local variables - real :: h_i, RLdiff, RLdiff2, RLmean, FunFac - character(len=256) :: mesg - integer :: i,j + real :: h_i ! A copy of the cell-average layer thickness [H ~> m or kg m-2] + real :: RLdiff ! The difference between the input edge values [H ~> m or kg m-2] + real :: RLdiff2 ! The squared difference between the input edge values [H2 ~> m2 or kg2 m-4] + real :: RLmean ! The average of the input edge thicknesses [H ~> m or kg m-2] + real :: FunFac ! A curious product of the thickness slope and curvature [H2 ~> m2 or kg2 m-4] + integer :: i, j do j=jis,jie ; do i=iis,iie ! This limiter monotonizes the parabola following diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 3bdca94af3..8f26918253 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -11,7 +11,6 @@ module MOM_density_integrals use MOM_EOS, only : calculate_spec_vol use MOM_EOS, only : calculate_specific_vol_derivs use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg -use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type use MOM_string_functions, only : uppercase use MOM_variables, only : thermo_var_ptrs @@ -428,13 +427,13 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz(HI%iscB:HI%iecB+1) ! Layer thicknesses at tracer points [Z ~> m] - real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subrid locations [Z ~> m] - real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m] + real :: dz_x(5,HI%iscB:HI%iecB) ! Layer thicknesses along an x-line of subgrid locations [Z ~> m] + real :: dz_y(5,HI%isc:HI%iec) ! Layer thicknesses along a y-line of subgrid locations [Z ~> m] real :: massWeightToggle ! A non-dimensional toggle factor (0 or 1) [nondim] real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [degC] real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners [ppt] real :: z0pres ! The height at which the pressure is zero [Z ~> m] - real :: hWght ! A topographically limited thicknes weight [Z ~> m] + real :: hWght ! A topographically limited thickness weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] logical :: use_stanley_eos ! True is SGS variance fields exist in tv. @@ -864,7 +863,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: T_top, T_mn, T_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of T real :: S_top, S_mn, S_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of S real :: z0pres ! The height at which the pressure is zero [Z ~> m] - real :: hWght ! A topographically limited thicknes weight [Z ~> m] + real :: hWght ! A topographically limited thickness weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n @@ -1455,7 +1454,10 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: p15(15) ! Pressures at fifteen quadrature points, scaled back to Pa as necessary [Pa] real :: a15(15) ! Specific volumes at fifteen quadrature points [R-1 ~> m3 kg-1] or [m3 kg-1] real :: wt_t(5), wt_b(5) ! Weights of top and bottom values at quadrature points [nondim] - real :: T_top, T_bot, S_top, S_bot, P_top, P_bot + real :: T_top, T_bot ! Horizontally interpolated temperature at the cell top and bottom [degC] + real :: S_top, S_bot ! Horizontally interpolated salinity at the cell top and bottom [ppt] + real :: P_top, P_bot ! Horizontally interpolated pressure at the cell top and bottom, + ! scaled back to Pa as necessary [Pa] real :: alpha_anom ! The depth averaged specific density anomaly [R-1 ~> m3 kg-1] or [m3 kg-1] real :: dp ! The pressure change through a layer [R L2 T-2 ~> Pa] diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 1c045926de..d0a324f96f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -148,15 +148,15 @@ module MOM_dynamics_split_RK2 !! dynamically. real :: be !< A nondimensional number from 0.5 to 1 that controls - !! the backward weighting of the time stepping scheme. + !! the backward weighting of the time stepping scheme [nondim] real :: begw !< A nondimensional number from 0 to 1 that controls !! the extent to which the treatment of gravity waves !! is forward-backward (0) or simulated backward - !! Euler (1). 0 is almost always used. + !! Euler (1) [nondim]. 0 is often used. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_OBC !< If true, do debugging calls for open boundary conditions. - logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. + logical :: module_is_initialized = .false. !< Record whether this module has been initialized. !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 @@ -254,41 +254,41 @@ module MOM_dynamics_split_RK2 subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, calc_dtbt, VarMix, & MEKE, thickness_diffuse_CSp, pbv, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid 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(SZIB_(G),SZJ_(G),SZK_(GV)), & - target, intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + target, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - target, intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] + target, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] 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 - type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step [T ~> s] + 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 + type(time_type), intent(in) :: Time_local !< Model time at end of time step + real, intent(in) :: dt !< Baroclinic dynamics time step [T ~> s] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at the start of this dynamic + real, dimension(:,:), pointer :: p_surf_begin !< Surface pressure at the start of this dynamic !! time step [R L2 T-2 ~> Pa] - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at the end of this dynamic + real, dimension(:,:), pointer :: p_surf_end !< Surface pressure at the end of this dynamic !! time step [R L2 T-2 ~> Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport + target, intent(inout) :: uh !< Zonal volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport + target, intent(inout) :: vh !< Meridional volume or mass transport !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uhtr !< accumulatated zonal volume/mass transport + intent(inout) :: uhtr !< Accumulated zonal volume or mass transport !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vhtr !< accumulatated merid volume/mass transport + intent(inout) :: vhtr !< Accumulated meridional volume or 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 + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< Free surface height or column mass !! averaged over time step [H ~> m or kg m-2] - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct + type(MOM_dyn_split_RK2_CS), pointer :: CS !< Module control structure + logical, intent(in) :: calc_dtbt !< If true, recalculate the barotropic time step + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities @@ -324,12 +324,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real :: pres_to_eta ! A factor that converts pressures to the units of eta ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1] real, pointer, dimension(:,:) :: & - p_surf => NULL(), eta_PF_start => NULL(), & - taux_bot => NULL(), tauy_bot => NULL(), & - eta => NULL() + p_surf => NULL(), & ! A pointer to the surface pressure [R L2 T-2 ~> Pa] + eta_PF_start => NULL(), & ! The value of eta that corresponds to the starting pressure + ! for the barotropic solver [H ~> m or kg m-2] + taux_bot => NULL(), & ! A pointer to the zonal bottom stress in some cases [R L Z T-2 ~> Pa] + tauy_bot => NULL(), & ! A pointer to the meridional bottom stress in some cases [R L Z T-2 ~> Pa] + ! This pointer is just used as shorthand for CS%eta. + eta => NULL() ! A pointer to the instantaneous free surface height (in Boussinesq + ! mode) or column mass anomaly (in non-Boussinesq mode) [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & - uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & + ! These pointers are used to alter which fields are passed to btstep with various options: + u_ptr => NULL(), & ! A pointer to a zonal velocity [L T-1] + v_ptr => NULL(), & ! A pointer to a meridional velocity [L T-1] + uh_ptr => NULL(), & ! A pointer to a zonal volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + vh_ptr => NULL(), & ! A pointer to a meridional volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + ! These pointers are just used as shorthand for CS%u_av, CS%v_av, and CS%h_av. u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. @@ -339,12 +349,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! hf_CAu, hf_CAv, & ! Coriolis force accel. x fract. thickness [L T-2 ~> m s-2]. ! hf_u_BT_accel, hf_v_BT_accel ! barotropic correction accel. x fract. thickness [L T-2 ~> m s-2]. ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. + ! The code is retained for debugging purposes in the future. real, allocatable, dimension(:,:) :: & - hf_PFu_2d, hf_PFv_2d, & ! Depth integeral of hf_PFu, hf_PFv [L T-2 ~> m s-2]. - hf_CAu_2d, hf_CAv_2d, & ! Depth integeral of hf_CAu, hf_CAv [L T-2 ~> m s-2]. - hf_u_BT_accel_2d, hf_v_BT_accel_2d ! Depth integeral of hf_u_BT_accel, hf_v_BT_accel + hf_PFu_2d, hf_PFv_2d, & ! Depth integral of hf_PFu, hf_PFv [L T-2 ~> m s-2]. + hf_CAu_2d, hf_CAv_2d, & ! Depth integral of hf_CAu, hf_CAv [L T-2 ~> m s-2]. + hf_u_BT_accel_2d, hf_v_BT_accel_2d ! Depth integral of hf_u_BT_accel, hf_v_BT_accel ! Diagnostics for thickness x momentum budget terms real, allocatable, dimension(:,:,:) :: & @@ -352,7 +362,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s h_CAu, h_CAv, & ! Coriolis force accel. x thickness [H L T-2 ~> m2 s-2]. h_u_BT_accel, h_v_BT_accel ! barotropic correction accel. x thickness [H L T-2 ~> m2 s-2]. - ! Dignostics for layer-sum of thickness x momentum budget terms + ! Diagnostics for layer-sum of thickness x momentum budget terms real, dimension(SZIB_(G),SZJ_(G)) :: & intz_PFu_2d, intz_CAu_2d, intz_u_BT_accel_2d ! [H L T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJB_(G)) :: & @@ -888,6 +898,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! The time-averaged free surface height has already been set by the last ! call to btstep. + ! Deallocate this memory to avoid a memory leak. ###We should also revisit how this array is declared. - RWH + !### if (dyn_p_surf .and. associated(eta_PF_start)) deallocate(eta_PF_start) + ! Here various terms used in to update the momentum equations are ! offered for time averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) @@ -922,7 +935,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! Diagnostics for terms multiplied by fractional thicknesses ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. + ! The code is retained for debugging purposes in the future. !if (CS%id_hf_PFu > 0) then ! allocate(hf_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq @@ -1173,18 +1186,18 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s end subroutine step_MOM_dyn_split_RK2 !> This subroutine sets up any auxiliary restart variables that are specific -!! to the unsplit time stepping scheme. All variables registered here should +!! to the split-explicit time stepping scheme. All variables registered here should !! have the ability to be recreated if they are not present in a restart file. subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, uh, vh) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] type(vardesc) :: vd(2) character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -1270,7 +1283,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(param_file_type), intent(in) :: param_file !< parameter file for parsing type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure real, intent(in) :: dt !< time step [T ~> s] type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for !! budget analysis @@ -1280,7 +1293,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(VarMix_CS), intent(inout) :: VarMix !< points to spatially variable viscosities type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to the control structure - !! used for the isopycnal height diffusive transport. + !! used for the isopycnal height diffusive transport. type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure @@ -1296,19 +1309,19 @@ 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_(GV)) :: h_tmp + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tmp ! A temporary copy of the layer thicknesses [H ~> m or kg m-2] character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=48) :: thickness_units, flux_units, eta_rest_name - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: vel_rescale ! A rescaling factor for velocities from the representation in - ! a restart file to the internal representation in this run. - real :: uH_rescale ! A rescaling factor for thickness transports from the representation in - ! a restart file to the internal representation in this run. - real :: accel_rescale ! A rescaling factor for accelerations from the representation in - ! a restart file to the internal representation in this run. + real :: H_rescale ! A rescaling factor for thicknesses from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] + real :: vel_rescale ! A rescaling factor for velocities from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] + real :: accel_rescale ! A rescaling factor for accelerations from the representation in a + ! restart file to the internal representation in this run [various units ~> 1] type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6edf5aeacc..88a11e071c 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -12,7 +12,7 @@ module MOM_dynamics_unsplit !* Runge-Kutta time stepping scheme for the momentum and a forward- * !* backward coupling between the momentum and continuity equations. * !* This was the orignal unsplit time stepping scheme used in early * -!* versions of HIM and its precuror. While it is very simple and * +!* versions of HIM and its precursor. While it is very simple and * !* accurate, it is much less efficient that the split time stepping * !* scheme for realistic oceanographic applications. It has been * !* retained for all of these years primarily to verify that the split * @@ -121,7 +121,7 @@ module MOM_dynamics_unsplit !! for viscosity. The default should be true, but it is false. logical :: debug !< If true, write verbose checksums for debugging purposes. - logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. + logical :: module_is_initialized = .false. !< Record whether this module has been initialized. !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 @@ -215,19 +215,19 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. - type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp ! Predicted 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(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] - real, dimension(:,:), pointer :: p_surf => NULL() + real, dimension(:,:), pointer :: p_surf => NULL() ! A pointer to the surface pressure [R L2 T-2 ~> Pa] 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 @@ -603,7 +603,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS !! the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE control !! structure. - type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control struct + type(set_visc_CS), target, intent(in) :: set_visc !< set_visc control structure type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities, bottom drag !! viscosities, and related fields. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 862082d567..26bd00aaf5 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -113,17 +113,17 @@ module MOM_dynamics_unsplit_RK2 !! to the seafloor [R L Z T-2 ~> Pa] real :: be !< A nondimensional number from 0.5 to 1 that controls - !! the backward weighting of the time stepping scheme. + !! the backward weighting of the time stepping scheme [nondim]. real :: begw !< A nondimensional number from 0 to 1 that controls !! the extent to which the treatment of gravity waves !! is forward-backward (0) or simulated backward - !! Euler (1). 0 is almost always used. + !! Euler (1) [nondim]. 0 is often used. logical :: use_correct_dt_visc !< If true, use the correct timestep in the calculation of the !! turbulent mixed layer properties for viscosity. !! The default should be true, but it is false. logical :: debug !< If true, write verbose checksums for debugging purposes. - logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. + logical :: module_is_initialized = .false. !< Record whether this module has been initialized. !>@{ Diagnostic IDs integer :: id_uh = -1, id_vh = -1 @@ -226,18 +226,19 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. - type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! fields related to the Mesoscale !! Eddy Kinetic Energy. type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av ! Averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted layer thicknesses [H ~> m or kg m-2] 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(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] - real, dimension(:,:), pointer :: p_surf => NULL() + real, dimension(:,:), pointer :: p_surf => NULL() ! A pointer to the surface pressure [R L2 T-2 ~> Pa] 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 @@ -548,7 +549,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag !! to the appropriate control structure. type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE !! control structure. - type(set_visc_CS), target, intent(in) :: set_visc !< set visc control struct + type(set_visc_CS), target, intent(in) :: set_visc !< set visc control structure type(vertvisc_type), intent(inout) :: visc !< A structure containing !! vertical viscosities, bottom drag !! viscosities, and related fields. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9cec8587db..5d9d319a49 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -104,8 +104,11 @@ module MOM_forcing_type lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1] frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1] seaice_melt => NULL(), & !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] - netMassIn => NULL(), & !< Sum of water mass flux out of the ocean [kg m-2 s-1] - netMassOut => NULL(), & !< Net water mass flux into of the ocean [kg m-2 s-1] + netMassIn => NULL(), & !< Sum of water mass flux out of the ocean integrated over a + !! forcing timestep [H ~> m or kg m-2] + netMassOut => NULL(), & !< Net water mass flux into of the ocean integrated over a + !! forcing timestep [H ~> m or kg m-2] + !### Net salt is used with inconsistent units and only in one place and should be eliminated as unneeded. netSalt => NULL() !< Net salt entering the ocean [kgSalt m-2 s-1] ! heat associated with water crossing ocean surface @@ -152,14 +155,14 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z T-1 ~> m s-1]. - area_berg => NULL(), & !< area of ocean surface covered by icebergs [m2 m-2] + area_berg => NULL(), & !< fractional area of ocean surface covered by icebergs [nondim] mass_berg => NULL() !< mass of icebergs [R Z ~> kg m-2] ! land ice-shelf related inputs real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z T-1 ~> m s-1]. !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of - !! h-cells, nondimensional from 0 to 1. This is only + !! h-cells, from 0 to 1 [nondim]. This is only !! associated if ice shelves are enabled, and are !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) @@ -177,7 +180,7 @@ module MOM_forcing_type !! fluxes have been applied to the ocean. real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes !! should be applied [T ~> s]. If negative, this forcing - !! type variable has not yet been inialized. + !! type variable has not yet been initialized. logical :: gustless_accum_bug = .true. !< If true, use an incorrect expression in the time !! average of the gustless wind stress. real :: C_p !< heat capacity of seawater [Q degC-1 ~> J kg-1 degC-1]. @@ -231,7 +234,7 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & - area_berg => NULL(), & !< fractional area of ocean surface covered by icebergs [m2 m-2] + area_berg => NULL(), & !< fractional area of ocean surface covered by icebergs [nondim] mass_berg => NULL() !< mass of icebergs per unit ocean area [R Z ~> kg m-2] ! land ice-shelf related inputs @@ -257,15 +260,15 @@ module MOM_forcing_type !! ice needs to be accumulated, and the rigidity explicitly !! reset to zero at the driver level when appropriate. real, pointer, dimension(:,:) :: & - ustk0 => NULL(), & !< Surface Stokes drift, zonal [m/s] - vstk0 => NULL() !< Surface Stokes drift, meridional [m/s] + ustk0 => NULL(), & !< Surface Stokes drift, zonal [m s-1] + vstk0 => NULL() !< Surface Stokes drift, meridional [m s-1] real, pointer, dimension(:) :: & - stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad/m] + stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad m-1] real, pointer, dimension(:,:,:) :: & - ustkb => NULL(), & !< Stokes Drift spectrum, zonal [m/s] + ustkb => NULL(), & !< Stokes Drift spectrum, zonal [m s-1] !! Horizontal - u points !! 3rd dimension - wavenumber - vstkb => NULL() !< Stokes Drift spectrum, meridional [m/s] + vstkb => NULL() !< Stokes Drift spectrum, meridional [m s-1] !! Horizontal - v points !! 3rd dimension - wavenumber @@ -460,7 +463,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real :: Ih_limit ! inverse depth at which surface fluxes start to be limited ! or 0 for no limiting [H-1 ~> m-1 or m2 kg-1] - real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth + real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth [nondim] real :: I_Cp ! 1.0 / C_p [degC Q-1 ~> kg degC J-1] real :: I_Cp_Hconvert ! Unit conversion factors divided by the heat capacity ! [degC H R-1 Z-1 Q-1 ~> degC m3 J-1 or kg degC J-1] @@ -946,23 +949,21 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt logical :: useRiverHeatContent logical :: useCalvingHeatContent - real :: depthBeforeScalingFluxes ! A depth scale [H ~> m or kg m-2] real :: GoRho ! The gravitational acceleration divided by mean density times a ! unit conversion factor [L2 H-1 R-1 T-2 ~> m4 kg-1 s-2 or m7 kg-2 s-2] - real :: H_limit_fluxes ! Another depth scale [H ~> m or kg m-2] + real :: H_limit_fluxes ! A depth scale that specifies when the ocean is shallow that + ! it is necessary to eliminate fluxes [H ~> m or kg m-2] integer :: i, k ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. useCalvingHeatContent = .False. - depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) + H_limit_fluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. if (associated(tv%p_surf)) then ; do i=G%isc,G%iec ; pressure(i) = tv%p_surf(i,j) ; enddo ; endif GoRho = (GV%g_Earth * GV%H_to_Z) / GV%Rho0 - H_limit_fluxes = depthBeforeScalingFluxes - ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: ! netH = water added/removed via surface fluxes [H T-1 ~> m s-1 or kg m-2 s-1] @@ -971,7 +972,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux ! this call returns the rate because dt=1 (in arbitrary time units) call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, 1.0, & - depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & + H_limit_fluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & netSalt, penSWbnd, tv, .false.) @@ -1421,11 +1422,10 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_massout_flux = register_diag_field('ocean_model', 'massout_flux', diag%axesT1, Time, & 'Net mass flux of freshwater out of the ocean (used in the boundary flux calculation)', & 'kg m-2', conversion=diag%GV%H_to_kg_m2) - ! This diagnostic is calculated in MKS units. handles%id_massin_flux = register_diag_field('ocean_model', 'massin_flux', diag%axesT1, Time, & - 'Net mass flux of freshwater into the ocean (used in boundary flux calculation)', 'kg m-2') - ! This diagnostic is calculated in MKS units. + 'Net mass flux of freshwater into the ocean (used in boundary flux calculation)', & + 'kg m-2', conversion=diag%GV%H_to_kg_m2) !========================================================================= ! area integrated surface mass transport, all are rescaled to MKS units before area integration. @@ -1981,12 +1981,12 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) real, intent(out) :: wt2 !< The relative weight of the new fluxes type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces - ! This subroutine copies mechancal forcing from flux_tmp to fluxes and + ! This subroutine copies mechanical forcing from flux_tmp to fluxes and ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, ! and increments the amount of time over which the buoyancy forcing in fluxes should be ! applied based on the time interval stored in flux_tmp. - real :: wt1 + real :: wt1 ! The relative weight of the previous fluxes [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2342,17 +2342,18 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h type(diag_ctrl), intent(inout) :: diag !< diagnostic regulator type(forcing_diags), intent(inout) :: handles !< diagnostic ids - ! local + ! local variables type(ocean_grid_type), pointer :: G ! Grid metric on model index map type(forcing), pointer :: fluxes ! Fluxes on the model index map - real, dimension(SZI_(diag%G),SZJ_(diag%G)) :: res - real :: total_transport ! for diagnosing integrated boundary transport - real :: ave_flux ! for diagnosing averaged boundary flux + real, dimension(SZI_(diag%G),SZJ_(diag%G)) :: res ! A temporary array for rescaled combinations + ! of fluxes in MKS units, like [kg m-2 s-1] or [W m-2] + real :: total_transport ! for diagnosing integrated boundary transport, in MKS units like [kg s-1] or [W] + real :: ave_flux ! for diagnosing averaged boundary flux, in MKS units like [kg m-2 s-1] or [W m-2] real :: RZ_T_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1] real :: I_dt ! inverse time step [T-1 ~> s-1] - real :: ppt2mks ! conversion between ppt and mks + real :: ppt2mks ! conversion between ppt and mks units [nondim] integer :: turns ! Number of index quarter turns - integer :: i,j,is,ie,js,je + integer :: i, j, is, ie, js, je call cpu_clock_begin(handles%id_clock_forcing) @@ -3306,8 +3307,8 @@ end subroutine deallocate_mech_forcing !< Rotate the fluxes by a set number of quarter turns subroutine rotate_forcing(fluxes_in, fluxes, turns) - type(forcing), intent(in) :: fluxes_in !< Input forcing struct - type(forcing), intent(inout) :: fluxes !< Rotated forcing struct + type(forcing), intent(in) :: fluxes_in !< Input forcing structure + type(forcing), intent(inout) :: fluxes !< Rotated forcing structure integer, intent(in) :: turns !< Number of quarter turns logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & @@ -3504,7 +3505,7 @@ end subroutine rotate_mech_forcing !! \subsection subsection_mass_fluxes Surface boundary mass fluxes !! !! The ocean gains or loses mass through evaporation, precipitation, -!! sea ice melt/form, and and river runoff. Positive mass fluxes +!! sea ice melt/form, and river runoff. Positive mass fluxes !! add mass to the liquid ocean. The boundary mass flux units are !! (kilogram per square meter per sec: kg/(m2/sec)). !! diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 1e63d033f2..d9ed8ffee4 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -59,8 +59,8 @@ module MOM_grid integer :: JsgB !< The start j-index of cell vertices within the global domain integer :: JegB !< The end j-index of cell vertices within the global domain - integer :: isd_global !< The value of isd in the global index space (decompoistion invariant). - integer :: jsd_global !< The value of isd in the global index space (decompoistion invariant). + integer :: isd_global !< The value of isd in the global index space (decomposition invariant). + integer :: jsd_global !< The value of isd in the global index space (decomposition invariant). integer :: idg_offset !< The offset between the corresponding global and local i-indices. integer :: jdg_offset !< The offset between the corresponding global and local j-indices. integer :: ke !< The number of layers in the vertical. @@ -206,7 +206,7 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v !! are entirely determined from thickness points. ! Local variables - real :: mean_SeaLev_scale + real :: mean_SeaLev_scale ! A scaling factor for the reference height variable [1] or [Z m-1 ~> 1] integer :: isd, ied, jsd, jed, nk integer :: IsdB, IedB, JsdB, JedB integer :: ied_max, jed_max @@ -398,10 +398,10 @@ end subroutine MOM_grid_init subroutine rescale_grid_bathymetry(G, m_in_new_units) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. - ! It appears that this routine is never called. + !### It appears that this routine is never called. ! Local variables - real :: rescale + real :: rescale ! A unit rescaling factor [various combinations of units ~> 1] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -489,14 +489,16 @@ logical function isPointInCell(G, i, j, x, y) real, intent(in) :: x !< x coordinate of point real, intent(in) :: y !< y coordinate of point ! Local variables - real :: xNE, xNW, xSE, xSW, yNE, yNW, ySE, ySW - real :: p0, p1, p2, p3, l0, l1, l2, l3 + real :: xNE, xNW, xSE, xSW ! Longitudes of cell corners [degLon] + real :: yNE, yNW, ySE, ySW ! Latitudes of cell corners [degLat] + real :: l0, l1, l2, l3 ! Crossed products of differences in position [degLon degLat] + real :: p0, p1, p2, p3 ! Trinary unitary values reflecting the signs of the crossed products [nondim] isPointInCell = .false. xNE = G%geoLonBu(i ,j ) ; yNE = G%geoLatBu(i ,j ) xNW = G%geoLonBu(i-1,j ) ; yNW = G%geoLatBu(i-1,j ) xSE = G%geoLonBu(i ,j-1) ; ySE = G%geoLatBu(i ,j-1) xSW = G%geoLonBu(i-1,j-1) ; ySW = G%geoLatBu(i-1,j-1) - ! This is a crude calculation that assume a geographic coordinate system + ! This is a crude calculation that assumes a geographic coordinate system if (xmax(xNE,xNW,xSE,xSW) .or. & ymax(yNE,yNW,ySE,ySW) ) then return ! Avoid the more complicated calculation diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 17729e586c..7047dd6421 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -17,7 +17,7 @@ module MOM_interface_heights public find_eta -!> Calculates the heights of sruface or all interfaces from layer thicknesses. +!> Calculates the heights of the free surface or all interfaces from layer thicknesses. interface find_eta module procedure find_eta_2d, find_eta_3d end interface find_eta diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 40777c8227..80d94ec7fe 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -102,15 +102,15 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & 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 :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. - real :: dz_neglect ! A change in interface heighs that is so small it is usually lost + real :: dz_neglect ! A change in interface heights that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real :: G_Rho0 ! The gravitational acceleration divided by density [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] real :: Z_to_L ! A conversion factor between from units for e to the - ! units for lateral distances. + ! units for lateral distances [L Z-1 ~> 1] real :: L_to_Z ! A conversion factor between from units for lateral distances - ! to the units for e. - real :: H_to_Z ! A conversion factor from thickness units to the units of e. + ! to the units for e [Z L-1 ~> 1] + real :: H_to_Z ! A conversion factor from thickness units to the units of e [Z H-1 ~> 1 or m3 kg-1] logical :: present_N2_u, present_N2_v integer, dimension(2) :: EOSdom_u, EOSdom_v ! Domains for the equation of state calculations at u and v points @@ -457,7 +457,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar 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 - ! completely decouping groups of layers [H ~> m or kg m-2]. + ! completely decoupling groups of layers [H ~> m or kg m-2]. ! Often 0 < h_neglect << h0. 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]. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index cb9422a412..6d8696216a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -203,8 +203,8 @@ module MOM_open_boundary type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale_out !< An effective inverse length scale for restoring - !! the tracer concentration in a ficticious - !! reservior towards interior values when flow + !! the tracer concentration in a fictitious + !! reservoir towards interior values when flow !! is exiting the domain [L-1 ~> m-1] real :: Tr_InvLscale_in !< An effective inverse length scale for restoring !! the tracer concentration towards an externally @@ -283,7 +283,7 @@ module MOM_open_boundary ! The following parameters are used in the baroclinic radiation code: real :: gamma_uv !< The relative weighting for the baroclinic radiation !! velocities (or speed of characteristics) at the - !! new time level (1) or the running mean (0) for velocities. + !! new time level (1) or the running mean (0) for velocities [nondim]. !! Valid values range from 0 to 1, with a default of 0.3. real :: rx_max !< The maximum magnitude of the baroclinic radiation velocity (or speed of !! characteristics) in units of grid points per timestep [nondim]. @@ -303,13 +303,12 @@ module MOM_open_boundary !! the independence of the OBCs to this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that can be used to test !! the independence of the OBCs to this external data [L T-1 ~> m s-1]. - logical :: ramp = .false. !< If True, ramp from zero to the external values - !! for SSH. + logical :: ramp = .false. !< If True, ramp from zero to the external values for SSH. logical :: ramping_is_activated = .false. !< True if the ramping has been initialized - real :: ramp_timescale !< If ramp is True, use this timescale for ramping. - real :: trunc_ramp_time !< If ramp is True, time after which ramp is done. + real :: ramp_timescale !< If ramp is True, use this timescale for ramping [s]. + real :: trunc_ramp_time !< If ramp is True, time after which ramp is done [s]. real :: ramp_value !< If ramp is True, where we are on the ramp from - !! zero to one. + !! zero to one [nondim]. type(time_type) :: ramp_start_time !< Time when model was started. end type ocean_OBC_type @@ -653,7 +652,7 @@ subroutine initialize_segment_data(G, OBC, PF) character(len=256) :: filename character(len=20) :: segnam, suffix character(len=32) :: varnam, fieldname - real :: value + real :: value ! A value that is parsed from the segment data string [various units] character(len=32), dimension(MAX_OBC_FIELDS) :: fields ! segment field names character(len=128) :: inputdir type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -896,7 +895,7 @@ subroutine initialize_segment_data(G, OBC, PF) segment%field(m)%value = value segment%field(m)%name = trim(fields(m)) ! Check if this is a tidal field. If so, the number - ! of expected constiuents must be 1. + ! of expected constituents must be 1. if ((index(segment%field(m)%name, 'phase') > 0) .or. (index(segment%field(m)%name, 'amp') > 0)) then if (OBC%n_tide_constituents .gt. 1 .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Only one constituent is supported when specifying '//& @@ -1025,7 +1024,7 @@ subroutine initialize_obc_tides(OBC, param_file) " are true, or if OBC_TIDE_N_CONSTITUENTS > 0 and "//trim(OBC%tide_names(c))//& " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=tidal_frequency(trim(OBC%tide_names(c)))) - ! Find equilibrum phase if needed + ! Find equilibrium phase if needed if (OBC%add_eq_phase) then OBC%tide_eq_phases(c) = eq_phase(trim(OBC%tide_names(c)), OBC%tidal_longitudes) else @@ -1179,7 +1178,7 @@ subroutine setup_u_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_y) integer :: j, a_loop character(len=32) :: action_str(8) character(len=128) :: segment_param_str - real, allocatable, dimension(:) :: tnudge + real, allocatable, dimension(:) :: tnudge ! Nudging timescales [T ~> s] ! This returns the global indices for the segment call parse_segment_str(G%ieg, G%jeg, segment_str, I_obc, Js_obc, Je_obc, action_str, reentrant_y) @@ -1319,7 +1318,7 @@ subroutine setup_v_point_obc(OBC, G, US, segment_str, l_seg, PF, reentrant_x) integer :: i, a_loop character(len=32) :: action_str(8) character(len=128) :: segment_param_str - real, allocatable, dimension(:) :: tnudge + real, allocatable, dimension(:) :: tnudge ! Nudging timescales [T ~> s] ! This returns the global indices for the segment call parse_segment_str(G%ieg, G%jeg, segment_str, J_obc, Is_obc, Ie_obc, action_str, reentrant_x) @@ -1470,7 +1469,7 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ mn_max = nj_global if (.not. (word2(1:2)=='J=')) call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& "Second word of string '"//trim(segment_str)//"' must start with 'J='.") - elseif (word1(1:2)=='J=') then ! Note that the file_parser uniformaly expands "=" to " = " + elseif (word1(1:2)=='J=') then ! Note that the file_parser uniformly expands "=" to " = " l_max = nj_global mn_max = ni_global if (.not. (word2(1:2)=='I=')) call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& @@ -1640,7 +1639,7 @@ subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) character(len=256) :: filename character(len=20) :: segnam, suffix character(len=32) :: varnam, fieldname - real :: value + real :: value ! A value that is parsed from the segment data string [various units] character(len=32), dimension(MAX_OBC_FIELDS) :: fields ! segment field names type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list character(len=256) :: mesg ! Message for error messages. @@ -1910,7 +1909,7 @@ subroutine open_boundary_end(OBC) call open_boundary_dealloc(OBC) end subroutine open_boundary_end -!> Sets the slope of bathymetry normal to an open bounndary to zero. +!> Sets the slope of bathymetry normal to an open boundary to zero. subroutine open_boundary_impose_normal_slope(OBC, G, depth) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure @@ -2236,7 +2235,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 backward sasha for I-1 + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sashay for I-1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed if (gamma_u < 1.0) then @@ -2256,7 +2255,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sashay 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 @@ -2319,7 +2318,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sashay 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 @@ -2398,7 +2397,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdx = v_new(i,J,k)-v_new(i-1,J,k) !in new time backward sashay 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 @@ -2480,7 +2479,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sashay 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 @@ -2500,7 +2499,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sashay 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 @@ -2564,7 +2563,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sashay 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 @@ -2643,7 +2642,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdx = v_new(i+1,J,k)-v_new(i+2,J,k) !in new time backward sashay 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 @@ -2725,7 +2724,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sashay 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 @@ -2745,7 +2744,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sashay 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 @@ -2808,7 +2807,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = u_new(I,j-1,k)-u_new(I,j-2,k) !in new time backward sashay 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 @@ -2887,7 +2886,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = u_new(I,j,k)-u_new(I,j-1,k) !in new time backward sashay 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 @@ -2969,7 +2968,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sashay 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 @@ -2989,7 +2988,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sashay 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 @@ -3053,7 +3052,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sashay 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 @@ -3132,7 +3131,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, 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 + dhdy = u_new(I,j+1,k)-u_new(I,j+2,k) !in new time backward sashay 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 @@ -3420,19 +3419,8 @@ subroutine set_tracer_data(OBC, tv, h, G, GV, PF) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Thickness type(param_file_type), intent(in) :: PF !< Parameter file handle - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz, n - integer :: isd_off, jsd_off - integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list - character(len=40) :: mdl = "set_tracer_data" ! This subroutine's name. - character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path - - 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 = 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 + integer :: i, j, k, n ! For now, there are no radiation conditions applied to the thicknesses, since ! the thicknesses might not be physically motivated. Instead, sponges should be @@ -3723,23 +3711,23 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path type(OBC_segment_type), pointer :: segment => NULL() integer, dimension(4) :: siz - real, dimension(:,:,:), pointer :: tmp_buffer_in => NULL() ! Unrotated input + real, dimension(:,:,:), pointer :: tmp_buffer_in => NULL() ! Unrotated input [various units] integer :: ni_seg, nj_seg ! number of src gridpoints along the segments integer :: ni_buf, nj_buf ! Number of filled values in tmp_buffer integer :: i2, j2 ! indices for referencing local domain array integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain integer :: ishift, jshift ! offsets for staggered locations - real, dimension(:,:,:), allocatable, target :: tmp_buffer + real, dimension(:,:,:), allocatable, target :: tmp_buffer ! A buffer for input data [various units] real, dimension(:), allocatable :: h_stack ! Thicknesses at corner points [H ~> m or kg m-2] integer :: is_obc2, js_obc2 real :: net_H_src ! Total thickness of the incoming flow in the source field [H ~> m or kg m-2] real :: net_H_int ! Total thickness of the incoming flow in the model [H ~> m or kg m-2] - real :: scl_fac ! A nondimensional scaling factor [nondim] - real :: tidal_vel ! Tangential tidal velocity [m s-1] - real :: tidal_elev ! Tidal elevation at an OBC point [m] + real :: scl_fac ! A scaling factor to compensate for differences in total thicknesses [nondim] + real :: tidal_vel ! Interpolated tidal velocity at the OBC points [m s-1] + real :: tidal_elev ! Interpolated tidal elevation at the OBC points [m] real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1] - integer :: turns ! Number of index quarter turns - real :: time_delta ! Time since tidal reference date [s] + integer :: turns ! Number of index quarter turns + real :: time_delta ! Time since tidal reference date [s] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3857,15 +3845,15 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! NOTE: buffer is sized for vertex points, but may be used for faces if (siz(1)==1) then if (OBC%brushcutter_mode) then - allocate(tmp_buffer(1,nj_seg*2-1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(1,nj_seg*2-1,segment%field(m)%nk_src)) ! segment data is currently on supergrid else - allocate(tmp_buffer(1,nj_seg,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(1,nj_seg,segment%field(m)%nk_src)) ! segment data is currently on supergrid endif else if (OBC%brushcutter_mode) then - allocate(tmp_buffer(ni_seg*2-1,1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(ni_seg*2-1,1,segment%field(m)%nk_src)) ! segment data is currently on supergrid else - allocate(tmp_buffer(ni_seg,1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + allocate(tmp_buffer(ni_seg,1,segment%field(m)%nk_src)) ! segment data is currently on supergrid endif endif @@ -4351,11 +4339,12 @@ end subroutine update_OBC_segment_data subroutine update_OBC_ramp(Time, OBC, activate) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary structure - logical, optional, intent(in) :: activate !< Specifiy whether to record the value of + logical, optional, intent(in) :: activate !< Specify whether to record the value of !! Time as the beginning of the ramp period ! Local variables - real :: deltaTime, wghtA + real :: deltaTime ! The time since start of ramping [s] + real :: wghtA ! A temporary variable used to set OBC%ramp_value [nondim] character(len=12) :: msg if (.not. OBC%ramp) return ! This indicates the ramping is turned off @@ -4502,7 +4491,7 @@ subroutine segment_tracer_registry_init(param_file, segment) end subroutine segment_tracer_registry_init -!> Register a tracer array that is active on an OBC segment, potentially also specifing how the +!> Register a tracer array that is active on an OBC segment, potentially also specifying how the !! tracer inflow values are specified. subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_scalar, OBC_array) @@ -4974,7 +4963,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart else ! This would be coming from user code such as DOME. if (OBC%ntr /= Reg%ntr) then -! call MOM_error(FATAL, "open_boundary_regiser_restarts: Inconsistent value for ntr") +! call MOM_error(FATAL, "open_boundary_register_restarts: Inconsistent value for ntr") write(mesg,'("Inconsistent values for ntr ", I8," and ",I8,".")') OBC%ntr, Reg%ntr call MOM_error(WARNING, 'open_boundary_register_restarts: '//mesg) endif @@ -5115,7 +5104,7 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) integer :: n real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights [Z ~> m] real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] - real :: hTmp, eTmp, dilate + ! real :: dilate ! A factor by which to dilate the water column [nondim] character(len=100) :: mesg hTolerance = 0.1*US%m_to_Z diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 2b597e355f..b856cff3dc 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -90,7 +90,7 @@ subroutine verticalGridInit( param_file, GV, US ) ! Local variables integer :: nk, H_power - real :: H_rescale_factor + real :: H_rescale_factor ! The integer power of 2 by which thicknesses are rescaled [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 216b74c735..267d16a174 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -366,7 +366,7 @@ function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: CFC_cap_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index df86300351..008f6386c9 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -506,7 +506,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: OCMIP2_CFC_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index ca5fc65f37..4627d0ec80 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -583,7 +583,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde !! number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] type(g_tracer_type), pointer :: g_tracer, g_tracer_next real, dimension(:,:,:,:), pointer :: tr_field real, dimension(:,:,:), pointer :: tr_ptr diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index ef27146a18..19d40f2db1 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -174,8 +174,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) 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 + real :: Idt !< inverse of the time step [T-1 ~> s-1] + real :: tmp1, tmp2 !< temporary variables [conc H L2 ~> conc m3 or conc kg] call cpu_clock_begin(id_clock_lbd) Idt = 1./dt @@ -569,51 +569,50 @@ end subroutine boundary_k_range !> Calculate the lateral boundary diffusive fluxes using the layer by layer method. !! See \ref section_method subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_R, & - khtr_u, F_layer, area_L, area_R, CS) - - integer, intent(in ) :: boundary !< Which boundary layer SURFACE or BOTTOM [nondim] - integer, intent(in ) :: ke !< Number of layers in the native grid [nondim] - real, intent(in ) :: hbl_L !< Thickness of the boundary boundary - !! layer (left) [H ~> m or kg m-2] - real, intent(in ) :: hbl_R !< Thickness of the boundary boundary - !! layer (right) [H ~> m or kg m-2] - real, dimension(ke), intent(in ) :: h_L !< Thicknesses in the native grid (left) [H ~> m or kg m-2] - real, dimension(ke), intent(in ) :: h_R !< Thicknesses in the native grid (right) [H ~> m or kg m-2] - real, dimension(ke), intent(in ) :: phi_L !< Tracer values in the native grid (left) [conc] - real, dimension(ke), intent(in ) :: phi_R !< Tracer values in the native grid (right) [conc] - real, intent(in ) :: khtr_u !< Horizontal diffusivities times delta t - !! at a velocity point [L2 ~> m2] - real, dimension(ke), intent( out) :: F_layer !< Layerwise diffusive flux at U- or V-point in the native - !! grid [H L2 conc ~> m3 conc] - real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] - real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] - type(lbd_CS), pointer :: CS !< Lateral diffusion control structure - !! the boundary layer + khtr_u, F_layer, area_L, area_R, CS) + + integer, intent(in ) :: boundary !< Which boundary layer SURFACE or BOTTOM [nondim] + integer, intent(in ) :: ke !< Number of layers in the native grid [nondim] + real, intent(in ) :: hbl_L !< Thickness of the boundary boundary + !! layer (left) [H ~> m or kg m-2] + real, intent(in ) :: hbl_R !< Thickness of the boundary boundary + !! layer (right) [H ~> m or kg m-2] + real, dimension(ke), intent(in ) :: h_L !< Thicknesses in the native grid (left) [H ~> m or kg m-2] + real, dimension(ke), intent(in ) :: h_R !< Thicknesses in the native grid (right) [H ~> m or kg m-2] + real, dimension(ke), intent(in ) :: phi_L !< Tracer values in the native grid (left) [conc] + real, dimension(ke), intent(in ) :: phi_R !< Tracer values in the native grid (right) [conc] + real, intent(in ) :: khtr_u !< Horizontal diffusivities times the time step + !! at a velocity point [L2 ~> m2] + real, dimension(ke), intent( out) :: F_layer !< Layerwise diffusive flux at U- or V-point + !! in the native grid [H L2 conc ~> m3 conc] + real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] + real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] + type(lbd_CS), pointer :: CS !< Lateral diffusion control structure + ! Local variables - real, dimension(:), allocatable :: dz_top !< The LBD z grid to be created [L ~ m] - real, dimension(:), allocatable :: phi_L_z !< Tracer values in the ztop grid (left) [conc] - real, dimension(:), allocatable :: phi_R_z !< Tracer values in the ztop grid (right) [conc] - real, dimension(:), allocatable :: F_layer_z !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] - real, dimension(ke) :: h_vel !< Thicknesses at u- and v-points in the native grid - !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] - real :: khtr_avg !< Thickness-weighted diffusivity at the u-point [m^2 s^-1] + real, allocatable :: dz_top(:) !< The LBD z grid to be created [H ~> m or kg m-2] + real, allocatable :: phi_L_z(:) !< Tracer values in the ztop grid (left) [conc] + real, allocatable :: phi_R_z(:) !< Tracer values in the ztop grid (right) [conc] + real, allocatable :: F_layer_z(:) !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] + real :: h_vel(ke) !< Thicknesses at u- and v-points in the native grid + !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] + real :: khtr_avg !< Thickness-weighted diffusivity at the velocity-point [L2 T-1 ~> m s-1] !! This is just to remind developers that khtr_avg should be !! computed once khtr is 3D. - real :: htot !< Total column thickness [H ~> m or kg m-2] + real :: htot !< Total column thickness [H ~> m or kg m-2] integer :: k, k_bot_min, k_top_max !< k-indices, min and max for bottom and top, respectively integer :: k_bot_max, k_top_min !< k-indices, max and min for bottom and top, respectively integer :: k_bot_diff, k_top_diff !< different between left and right k-indices for bottom and top, respectively integer :: k_top_L, k_bot_L !< k-indices left native grid integer :: k_top_R, k_bot_R !< k-indices right native grid real :: zeta_top_L, zeta_top_R !< distance from the top of a layer to the boundary - !! layer depth in the native grid [nondim] + !! layer depth in the native grid [nondim] real :: zeta_bot_L, zeta_bot_R !< distance from the bottom of a layer to the boundary - !!layer depth in the native grid [nondim] - real :: hbl_min !< minimum BLD (left and right) [m] - real :: wgt !< weight to be used in the linear transition to the interior [nondim] + !! layer depth in the native grid [nondim] + real :: wgt !< weight to be used in the linear transition to the interior [nondim] real :: a !< coefficient to be used in the linear transition to the interior [nondim] - real :: tmp1, tmp2 !< dummy variables - real :: htot_max !< depth below which no fluxes should be applied + real :: tmp1, tmp2 !< dummy variables [H ~> m or kg m-2] + real :: htot_max !< depth below which no fluxes should be applied [H ~> m or kg m-2] integer :: nk !< number of layers in the LBD grid F_layer(:) = 0.0 @@ -743,16 +742,16 @@ logical function near_boundary_unit_tests( verbose ) integer, parameter :: nk = 2 ! Number of layers real, dimension(nk+1) :: eta1 ! Updated interfaces with one extra value [m] real, dimension(:), allocatable :: h1 ! Upates layer thicknesses [m] - real, dimension(nk) :: phi_L, phi_R ! Tracer values (left and right column) [ nondim m^-3 ] + real, dimension(nk) :: phi_L, phi_R ! Tracer values (left and right column) [conc] real, dimension(nk) :: h_L, h_R ! Layer thickness (left and right) [m] - real :: khtr_u ! Horizontal diffusivities at U-point [m^2 s^-1] + real :: khtr_u ! Horizontal diffusivities at U-point [m2 s-1] real :: hbl_L, hbl_R ! Depth of the boundary layer (left and right) [m] - real, dimension(nk) :: F_layer ! Diffusive flux within each layer at U-point [nondim s^-1] + real, dimension(nk) :: F_layer ! Diffusive flux within each layer at U-point [conc m3 s-1] character(len=120) :: test_name ! Title of the unit test integer :: k_top ! Index of cell containing top of boundary - real :: zeta_top ! Nondimension position + real :: zeta_top ! Nondimension position [nondim] integer :: k_bot ! Index of cell containing bottom of boundary - real :: zeta_bot ! Nondimension position + real :: zeta_bot ! Nondimension position [nondim] type(lbd_CS), pointer :: CS allocate(CS) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index a06af6cd57..fd479eeaf3 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -969,9 +969,9 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT [R degC-1 ~> kg m-3 degC-1] real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS [R ppt-1 ~> kg m-3 ppt-1] real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within - !! layer KoL of left column + !! layer KoL of left column [nondim] real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within - !! layer KoR of right column + !! layer KoR of right column [nondim] integer, dimension(2*nk+2), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(2*nk+2), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces @@ -986,7 +986,6 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS integer :: k_surface ! Index of neutral surface integer :: kl ! Index of left interface integer :: kr ! Index of right interface - real :: dRdT, dRdS ! dRho/dT [kg m-3 degC-1] and dRho/dS [kg m-3 ppt-1] for the neutral surface logical :: searching_left_column ! True if searching for the position of a right interface in the left column logical :: searching_right_column ! True if searching for the position of a left interface in the right column logical :: reached_bottom ! True if one of the bottom-most interfaces has been used as the target @@ -1246,7 +1245,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, & integer, optional, intent(in) :: k_bot_L !< k-index for the boundary layer (left) [nondim] integer, optional, intent(in) :: k_bot_R !< k-index for the boundary layer (right) [nondim] logical, optional, intent(in) :: hard_fail_heff !< If true (default) bring down the model if the - !! neutral surfaces ever cross [logical] + !! neutral surfaces ever cross ! Local variables integer :: ns ! Number of neutral surfaces integer :: k_surface ! Index of neutral surface diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 9486e87369..af8b422238 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -704,9 +704,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ fluxes%netMassOut(:,:) = 0.0 fluxes%netMassIn(:,:) = 0.0 call MOM_read_data(surf_file,'massout_flux_sum',fluxes%netMassOut, G%Domain, & - timelevel=ridx_sum) + timelevel=ridx_sum, scale=GV%kg_m2_to_H) call MOM_read_data(surf_file,'massin_flux_sum', fluxes%netMassIn, G%Domain, & - timelevel=ridx_sum) + timelevel=ridx_sum, scale=GV%kg_m2_to_H) do j=js,je ; do i=is,ie if (G%mask2dT(i,j)<1.0) then diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index c1e39598cc..a701c98553 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -425,7 +425,7 @@ 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_(GV)), intent(inout) :: Tr !< Tracer concentration on T-cell + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: Tr !< Tracer concentration on T-cell [conc] 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_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] @@ -436,30 +436,36 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim !! which fluxes can be applied [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated !! amount of tracer that enters with freshwater + !! [conc H ~> conc m or conc kg m-2] real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional !< The total time-integrated !! amount of tracer that leaves with freshwater + !! [conc H ~> conc m or conc kg m-2] logical, optional, intent(in) :: update_h_opt !< Optional flag to determine whether !! h should be updated integer, parameter :: maxGroundings = 5 integer :: numberOfGroundings, iGround(maxGroundings), jGround(maxGroundings) - real :: H_limit_fluxes, IforcingDepthScale - real :: dThickness, dTracer - real :: fractionOfForcing, hOld, Ithickness - real :: RivermixConst ! A constant used in implementing river mixing [Pa s]. - real, dimension(SZI_(G)) :: & - netMassInOut, & ! surface water fluxes [H ~> m or kg m-2] over time step - 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_(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! - ! that leaves with freshwater - real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d - real :: hGrounding(maxGroundings) - real :: Tr_in + real :: IforcingDepthScale ! The inverse of the scale over which to apply forcing [H-1 ~> m-1 or m2 kg-1] + real :: dThickness ! The change in a layer's thickness [H ~> m or kg m-2] + real :: dTracer ! The change in the integrated tracer content of a layer [conc H ~> conc m or conc kg m-2] + real :: fractionOfForcing ! The fraction of the forcing to apply to a layer [nondim] + real :: hOld ! The layer thickness before surface forcing is applied [H ~> m or kg m-2] + real :: Ithickness ! The inverse of the new layer thickness [H-1 ~> m-1 or m2 kg-1] + + real :: h2d(SZI_(G),SZK_(GV)) ! A 2-d work copy of layer thicknesses [H ~> m or kg m-2] + real :: Tr2d(SZI_(G),SZK_(GV)) ! A 2-d work copy of tracer concentrations [conc] + real :: in_flux(SZI_(G),SZJ_(G)) ! The total time-integrated amount of tracer that + ! enters with freshwater [conc H ~> conc m or conc kg m-2] + real :: out_flux(SZI_(G),SZJ_(G)) ! The total time-integrated amount of tracer that + ! leaves with freshwater [conc H ~> conc m or conc kg m-2] + real :: netMassIn(SZI_(G)) ! The remaining mass entering ocean surface [H ~> m or kg m-2] + real :: netMassOut(SZI_(G)) ! The remaining mass leaving ocean surface [H ~> m or kg m-2] + real :: in_flux_1d(SZI_(G)) ! The remaining amount of tracer that enters with + ! the freshwater [conc H ~> conc m or conc kg m-2] + real :: out_flux_1d(SZI_(G)) ! The remaining amount of tracer that leaves with + ! the freshwater [conc H ~> conc m or conc kg m-2] + real :: hGrounding(maxGroundings) ! The remaining fresh water flux that was not able to be + ! supplied from a column that grounded out [H ~> m or kg m-2] logical :: update_h integer :: i, j, is, ie, js, je, k, nz, n, nsw character(len=45) :: mesg @@ -493,10 +499,9 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim !$OMP IforcingDepthScale,minimum_forcing_depth, & !$OMP numberOfGroundings,iGround,jGround,update_h, & !$OMP in_flux,out_flux,hGrounding,evap_CFL_limit) & -!$OMP private(h2d,Tr2d,netMassInOut,netMassOut, & +!$OMP private(h2d,Tr2d,netMassIn,netMassOut, & !$OMP in_flux_1d,out_flux_1d,fractionOfForcing, & -!$OMP dThickness,dTracer,hOld,Ithickness, & -!$OMP netMassIn, Tr_in) +!$OMP dThickness,dTracer,hOld,Ithickness) ! Work in vertical slices for efficiency do j=js,je @@ -521,8 +526,8 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim ! Note here that the aggregateFW flag has already been taken care of in the call to ! applyBoundaryFluxesInOut do i=is,ie - netMassOut(i) = fluxes%netMassOut(i,j) - netMassIn(i) = fluxes%netMassIn(i,j) + netMassOut(i) = fluxes%netMassOut(i,j) + netMassIn(i) = fluxes%netMassIn(i,j) enddo ! Apply the surface boundary fluxes in three steps: diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index dedfe4e30a..c729231927 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -826,7 +826,7 @@ subroutine MOM_tracer_chkinv(mesg, G, GV, h, Tr, ntr) integer, intent(in) :: ntr !< number of registered tracers ! Local variables - real :: vol_scale ! The dimensional scaling factor to convert volumes to m3 [m3 H-1 L-2 ~> nondim or m3 kg-1] + real :: vol_scale ! The dimensional scaling factor to convert volumes to m3 [m3 H-1 L-2 ~> 1 or m3 kg-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tr_inv ! Volumetric tracer inventory in each cell [conc m3] real :: total_inv ! The total amount of tracer [conc m3] integer :: is, ie, js, je, nz diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index d6d1ac25fe..b713803182 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -358,7 +358,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: advection_test_stock !< the number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] 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/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index bc5d19b4fb..18e9b8dc8e 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -302,7 +302,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) ! is present, only the stock corresponding to that coded index is returned. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] 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/dye_example.F90 b/src/tracer/dye_example.F90 index 9a3ca019bd..91806bb94e 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -341,7 +341,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) !! calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] 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 60d9c02aa0..ca47a8ca1d 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -385,7 +385,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: ideal_age_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] 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/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 0ebf9dcfc9..862209a688 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -327,7 +327,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! Local variables 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 :: vol_scale ! A conversion factor for volumes into m3 [m3 H-1 L-2 ~> nondim or m3 kg-1] + real :: vol_scale ! A conversion factor for volumes into m3 [m3 H-1 L-2 ~> 1 or m3 kg-1] real :: year, h_total, ldecay integer :: i, j, k, is, ie, js, je, nz, m, k_max is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -414,7 +414,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) integer :: oil_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or nondim] + real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] 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 From a0248ef23b04f6ad8c75a766fff24627c8e40f3f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 28 Nov 2021 06:40:49 -0500 Subject: [PATCH 081/138] Minor code cleanup in drivers/FMS_cap Various minor code cleanup in the drivers/FMS_cap directory, including: o Rescaled the internal latent_heat variables in the control structure for MOM_surface_forcing_gfdl for improved dimensional consistency testing. o Removed the unused local variable PmE_adj in convert_IOB_to_fluxes(). o Corrected the documented units or fixed spelling errors in several comments. All answers and output are bitwise identical. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 58 +++++++++---------- .../drivers/FMS_cap/ocean_model_MOM.F90 | 14 ++--- 2 files changed, 35 insertions(+), 37 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 6479549eb7..5e156abb54 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -65,8 +65,8 @@ module MOM_surface_forcing_gfdl real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: area_surf = -1.0 !< Total ocean surface area [m2] - real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] - real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] + real :: latent_heat_fusion !< Latent heat of fusion [Q ~> J kg-1] + real :: latent_heat_vapor !< Latent heat of vaporization [Q ~> J kg-1] real :: max_p_surf !< The maximum surface pressure that can be exerted by !! the atmosphere and floating sea-ice [R L2 T-2 ~> Pa]. @@ -231,8 +231,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value [ppt] SSS_mean, & ! A (mean?) salinity about which to normalize local salinity ! anomalies when calculating restorative precipitation anomalies [ppt] - PmE_adj, & ! The adjustment to PminusE that will cause the salinity - ! to be restored toward its target value [kg m-1 s-1] net_FW, & ! The area integrated net freshwater flux into the ocean [kg s-1] net_FW2, & ! The net freshwater flux into the ocean [kg m-2 s-1] work_sum, & ! A 2-d array that is used as the work space for global sums [m2] or [kg s-1] @@ -245,7 +243,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, real :: delta_sss ! temporary storage for sss diff from restoring value [ppt] real :: delta_sst ! temporary storage for sst diff from restoring value [degC] - real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling + real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. real :: rhoXcp ! Reference density times heat capacity times unit scaling ! factors [Q R degC-1 ~> J m-3 degC-1] @@ -264,7 +262,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, kg_m2_s_conversion = US%kg_m2s_to_RZ_T if (CS%restore_temp) rhoXcp = CS%Rho0 * fluxes%C_p open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 fluxes%vPrecGlobalScl = 0.0 fluxes%saltFluxGlobalAdj = 0.0 @@ -490,19 +487,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - & - IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_fusion endif if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - & - IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*kg_m2_s_conversion * & + CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - & - IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*kg_m2_s_conversion * CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) @@ -601,7 +596,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + US%kg_m2s_to_RZ_T * & + fluxes%vprec(i,j) = fluxes%vprec(i,j) + kg_m2_s_conversion * & (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else @@ -670,7 +665,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real :: Kv_rho_ice ! (CS%Kv_sea_ice / CS%density_sea_ice) [L4 Z-2 T-1 R-1 ~> m5 s-1 kg-1] real :: mass_ice ! mass of sea ice at a face [R Z ~> kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [R Z ~> kg m-2] - real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. + real :: wt1, wt2 ! Relative weights of previous and current values of ustar [nondim]. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer @@ -891,9 +886,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses [R Z L T-2 ~> Pa] at h points real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses [R Z L T-2 ~> Pa] at h points - real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses [Pa] at u points + real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses [R Z L T-2 ~> Pa] at u points real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses [R Z L T-2 ~> Pa] at v points - real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses [Pa] at q points + real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses [R Z L T-2 ~> Pa] at q points real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses [R Z L T-2 ~> Pa] at q points real :: gustiness ! unresolved gustiness that contributes to ustar [R Z L T-2 ~> Pa] @@ -1109,7 +1104,8 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - real, dimension(G%isc:G%iec,G%jsc:G%jec) :: temp_at_h ! Various fluxes at h points [W m-2] or [kg m-2 s-1] + real, dimension(G%isc:G%iec,G%jsc:G%jec) :: temp_at_h ! Various fluxes at h points + ! [Q R Z T-1 ~> W m-2] or [R Z T-1 ~> kg m-2 s-1] integer :: isc, iec, jsc, jec, i, j logical :: overrode_h @@ -1120,7 +1116,7 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) scale=US%W_m2_to_QRZ_T) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j) * G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) @@ -1283,9 +1279,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & - "The latent heat of fusion.", units="J/kg", default=hlf) + "The latent heat of fusion.", units="J/kg", default=hlf, scale=US%J_kg_to_Q) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & - "The latent heat of fusion.", units="J/kg", default=hlv) + "The latent heat of fusion.", units="J/kg", default=hlv, scale=US%J_kg_to_Q) call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & "The maximum surface pressure that can be exerted by the "//& "atmosphere and floating sea-ice or ice shelves. This is "//& @@ -1373,12 +1369,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s,unscaled=unscaled_fluxconst) + default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s, unscaled=unscaled_fluxconst) call get_param(param_file, mdl, "FLUXCONST_SALT", CS%Flux_const_salt, & "The constant that relates the restoring surface salt fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & fail_if_missing=.false.,default=unscaled_fluxconst, units="m day-1", scale=US%m_to_Z*US%T_to_s) - ! Convert CS%Flux_const from m day-1 to m s-1. + ! Finish converting CS%Flux_const from m day-1 to [Z T-1 ~> m s-1]. CS%Flux_const = CS%Flux_const / 86400.0 CS%Flux_const_salt = CS%Flux_const_salt / 86400.0 call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1450,10 +1446,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) endif -! Optionally read tidal amplitude from input file [m s-1] on model grid. -! Otherwise use default tidal amplitude for bottom frictionally-generated -! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of -! work done against tides globally using OSU tidal amplitude. + ! Optionally read tidal amplitude from input file [Z T-1 ~> m s-1] on model grid. + ! Otherwise use default tidal amplitude for bottom frictionally-generated + ! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of + ! work done against tides globally using OSU tidal amplitude. + ! Note that the slightly unusual length scaling is deliberate, because the tidal + ! amplitudes are used to set the friction velocity. call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) @@ -1624,7 +1622,7 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end -!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type +!> Write out a set of messages with checksums of the fields in an ice_ocean_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) character(len=*), intent(in) :: id !< An identifying string for this call diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 50ea6c943d..93cf891bfe 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -86,7 +86,7 @@ module ocean_model_mod !> This type is used for communication with other components via the FMS coupler. !! The element names and types can be changed only with great deliberation, hence -!! the persistnce of things like the cutsy element name "avg_kount". +!! the persistence of things like the cutesy element name "avg_kount". type, public :: ocean_public_type type(domain2d) :: Domain !< The domain for the surface fields. logical :: is_ocean_pe !< .true. on processors that run the ocean model. @@ -110,8 +110,8 @@ module ocean_model_mod !! a global max across ocean and non-ocean processors can be !! used to determine its value. real, pointer, dimension(:,:) :: & - t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) - s_surf => NULL(), & !< SSS on t-cell (psu) + t_surf => NULL(), & !< SST on t-cell [degrees Kelvin] + s_surf => NULL(), & !< SSS on t-cell [ppt] u_surf => NULL(), & !< i-velocity at the locations indicated by stagger [m s-1]. v_surf => NULL(), & !< j-velocity at the locations indicated by stagger [m s-1]. sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, @@ -221,7 +221,7 @@ module ocean_model_mod !! for restarts and reading restart files if appropriate. !! !! This subroutine initializes both the ocean state and the ocean surface type. -!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! Because of the way that indices and domains are handled, Ocean_sfc must have !! been used in a previous call to initialize_ocean_type. subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas_fields_ocn) type(ocean_public_type), target, & @@ -766,7 +766,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, gas_field !! tracer fluxes. integer :: xsz, ysz, layout(2) - ! ice-ocean-boundary fields are always allocated using absolute indicies + ! ice-ocean-boundary fields are always allocated using absolute indices ! and have no halos. integer :: isc, iec, jsc, jec @@ -806,7 +806,7 @@ end subroutine initialize_ocean_public_type !! surface state variable. This may eventually be folded into the MOM !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no -!! halo points in its arrays and always uses absolute indicies. +!! halo points in its arrays and always uses absolute indices. subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -946,7 +946,7 @@ end subroutine ocean_model_init_sfc !> ocean_model_flux_init is used to initialize properties of the air-sea fluxes !! as determined by various run-time parameters. It can be called from -!! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely +!! non-ocean PEs, or PEs that have not yet been initialized, and it can safely !! be called multiple times. subroutine ocean_model_flux_init(OS, verbosity) type(ocean_state_type), optional, pointer :: OS !< An optional pointer to the ocean state, From f67e030646025eebdf1bff6addca675f3b006e84 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 1 Dec 2021 15:29:18 -0500 Subject: [PATCH 082/138] Cleaned up whitespace leftover from porous topomerge. - Spacing within expressions was uneven and made multiplation look like POW functions. Leftover from merging NOAA-GFDL/MOM6#3. - No answer changes. --- src/core/MOM_continuity_PPM.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 90e1086bc5..2dadaf869a 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -572,7 +572,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) - uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I))* u(I) * & + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then @@ -586,7 +586,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & uh(I) = 0.0 h_marg = 0.5 * (h_L(i+1) + h_R(i)) endif - duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h_marg * visc_rem(I) + duhdu(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then @@ -596,10 +596,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & if (l_seg /= OBC_NONE) then if (OBC%segment(l_seg)%open) then if (OBC%segment(l_seg)%direction == OBC_DIRECTION_E) then - uh(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * u(I) * h(i) - duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h(i) * visc_rem(I) + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * h(i) + duhdu(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * h(i) * visc_rem(I) else - uh(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * u(I) * h(i+1) + uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * h(i+1) duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h(i+1) * visc_rem(I) endif endif @@ -842,7 +842,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL,por_face_areaU(:,j,k),OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), OBC) enddo ; endif if (itt < max_itts) then @@ -992,9 +992,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, duhdu_0, & visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL,por_face_areaU(:,j,k)) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL,por_face_areaU(:,j,k)) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) do I=ish-1,ieh ; if (do_I(I)) then FAmt_0(I) = FAmt_0(I) + duhdu_0(I) FAmt_L(I) = FAmt_L(I) + duhdu_L(I) From ceb181f22636c9821e76d833624a196ba8b8de2c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 1 Dec 2021 15:31:42 -0500 Subject: [PATCH 083/138] Fix out-of-bounds k index in PPM flux - An errant use of the porous face area led to an out-of-bounds k-index reported in NOAA-GFDL/MOM6#19. - Closes #19 --- src/core/MOM_continuity_PPM.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 2dadaf869a..4e037998c9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -466,7 +466,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are if (l_seg /= OBC_NONE) & do_I(I) = OBC%segment(l_seg)%specified - if (do_I(I)) FAuI(I) = GV%H_subroundoff*(G%dy_Cu(I,j)*por_face_areaU(I,j,k)) + if (do_I(I)) FAuI(I) = GV%H_subroundoff*G%dy_Cu(I,j) enddo ! NOTE: do_I(I) should prevent access to segment OBC_NONE do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then @@ -1282,7 +1282,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac if(l_seg /= OBC_NONE) & do_I(i) = (OBC%segment(l_seg)%specified) - if (do_I(i)) FAvi(i) = GV%H_subroundoff*(G%dx_Cv(i,J)*por_face_areaV(i,J,k)) + if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) enddo ! NOTE: do_I(I) should prevent access to segment OBC_NONE do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then From d7167453e262690ba84b237f9bef39ce8aa0204d Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 1 Dec 2021 12:58:48 -0500 Subject: [PATCH 084/138] Testing: Codecov uploader update This patches updates the codecov uploader to the new version, replacing the bash uploader to be phased out in 2022. The uploader URL is now a configuable variable, and the coverage scripts have been modified to accommodate changes in the uploader. Under this new uploader, the coverage reports must be generated locally, rather than relying on the bash script to call gcov. So we now generate these scripts based on the *.gcda output. --- .testing/Makefile | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index bd0cbc4c0a..f330c92e3b 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -146,6 +146,7 @@ endif # These are set to true by our Travis configuration if testing a pull request DO_REGRESSION_TESTS ?= REPORT_COVERAGE ?= +CODECOV_UPLOADER_URL ?= https://uploader.codecov.io/latest/linux/codecov ifeq ($(DO_REGRESSION_TESTS), true) BUILDS += target @@ -165,6 +166,7 @@ else endif + # List of source files to link this Makefile's dependencies to model Makefiles # Assumes a depth of two, and the following extensions: F90 inc c h # (1): Root directory @@ -542,6 +544,7 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # $(4): MOM_override configuration # $(5): Environment variables # $(6): Number of MPI ranks + define STAT_RULE work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) @echo "Running test $$*.$(1)..." @@ -570,10 +573,13 @@ work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) @echo -e "$(DONE): $$*.$(1); no runtime errors." if [ $(3) ]; then \ mkdir -p results/$$* ; \ - cd build/symmetric \ - && bash <(curl -s https://codecov.io/bash) -Z -n $$@ \ - > codecov.$$*.$(1).out \ - 2> codecov.$$*.$(1).err \ + cd build/symmetric ; \ + gcov *.gcda > gcov.$$*.$(1).out ; \ + curl -s $(CODECOV_UPLOADER_URL) -o codecov ; \ + chmod +x codecov ; \ + ./codecov -Z -f "*.gcov" -n $$@ \ + > codecov.$$*.$(1).out \ + 2> codecov.$$*.$(1).err \ && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}"; \ fi endef From 6494852872b809352e417bd2adf3f6a567004e76 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 28 Nov 2021 06:48:46 -0500 Subject: [PATCH 085/138] Code cleanup in drivers/solo_driver forcing files Code cleanup in the drivers/FMS_cap directory forcing files, including: o Rescaled several internal wind stress variables in the control structure for solo_driver/MOM_surface_forcing.F90 for improved dimensional consistency testing. o Added the variable Pa_to_RLZ_T2 to help clarify the conversion factors being applied to several hard-coded constant stresses. These hard-coded constant wind stress magnitudes should be replaced with variables in wind_forcing_2gyre(), wind_forcing_1gyre() and Neverworld_wind_forcing() but this needs to be done carefully to avoid breaking existing solutions. o Removed or commented out unused variables, as appropriate. o Corrected or added documented units o Added comments describing all real variables in this directory. o Fixed spelling errors in several comments. All answers and output are bitwise identical. --- .../solo_driver/MESO_surface_forcing.F90 | 4 +- .../solo_driver/MOM_surface_forcing.F90 | 264 +++++++++--------- .../solo_driver/user_surface_forcing.F90 | 4 +- 3 files changed, 141 insertions(+), 131 deletions(-) diff --git a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 index 7c778d9753..f39dff2a0b 100644 --- a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 @@ -31,7 +31,7 @@ module MESO_surface_forcing real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [Pa]. + !! that contributes to ustar [R L Z T-1 ~> Pa] real, dimension(:,:), pointer :: & T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward [degC]. S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward [ppt] @@ -138,7 +138,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. do j=js,je ; do i=is,ie - ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] + ! Fluxes of fresh water through the surface are in units of [R Z T-1 ~> kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) fluxes%lprec(i,j) = CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j) diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 85c363b897..bf3d517b3d 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -79,12 +79,14 @@ module MOM_surface_forcing real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< piston velocity for surface restoring [Z T-1 ~> m s-1] - real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] + real :: Flux_const_T !< piston velocity for surface temperature restoring [Z T-1 ~> m s-1] real :: Flux_const_S !< piston velocity for surface salinity restoring [Z T-1 ~> m s-1] real :: latent_heat_fusion !< latent heat of fusion times [Q ~> J kg-1] real :: latent_heat_vapor !< latent heat of vaporization [Q ~> J kg-1] - real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing - real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" forcing + real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" + !! forcing [R L Z T-1 ~> Pa] + real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" + !! forcing [R L Z T-1 ~> Pa] real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] logical :: read_gust_2d !< if true, use 2-dimensional gustiness supplied from a file @@ -99,31 +101,31 @@ module MOM_surface_forcing ! if WIND_CONFIG=='gyres' then use the following as = A, B, C and n respectively for ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L) - real :: gyres_taux_const !< A constant wind stress [Pa]. - real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. - real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. - real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres' + real :: gyres_taux_const !< A constant wind stress [R L Z T-1 ~> Pa]. + real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover !! the answers from the end of 2018. Otherwise, use a form of the gyre !! wind stresses that are rotationally invariant and more likely to be !! the same between compilers. logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the !! gustless wind friction velocity. - ! if WIND_CONFIG=='scurves' then use the following to define a piecwise scurve profile + ! if WIND_CONFIG=='scurves' then use the following to define a piecewise scurve profile real :: scurves_ydata(20) = 90. !< Latitudes of scurve nodes [degreesN] - real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [Pa] + real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [R L Z T-1 ~> Pa] - real :: T_north !< target temperatures at north used in buoyancy_forcing_linear - real :: T_south !< target temperatures at south used in buoyancy_forcing_linear - real :: S_north !< target salinity at north used in buoyancy_forcing_linear - real :: S_south !< target salinity at south used in buoyancy_forcing_linear + real :: T_north !< Target temperatures at north used in buoyancy_forcing_linear [degC] + real :: T_south !< Target temperatures at south used in buoyancy_forcing_linear [degC] + real :: S_north !< Target salinity at north used in buoyancy_forcing_linear [ppt] + real :: S_south !< Target salinity at south used in buoyancy_forcing_linear [ppt] logical :: first_call_set_forcing = .true. !< True until after the first call to set_forcing logical :: archaic_OMIP_file = .true. !< If true use the variable names and data fields from !! a very old version of the OMIP forcing logical :: dataOverrideIsInitialized = .false. !< If true, data override has been initialized - real :: wind_scale !< value by which wind-stresses are scaled, ND. + real :: wind_scale !< value by which wind-stresses are scaled [nondim] real :: constantHeatForcing !< value used for sensible heat flux when buoy_config="const" [Q R Z T-1 ~> W m-2] character(len=8) :: wind_stagger !< A character indicating how the wind stress components @@ -371,32 +373,30 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: tau_x0 !< The zonal wind stress [Pa] - real, intent(in) :: tau_y0 !< The meridional wind stress [Pa] + real, intent(in) :: tau_x0 !< The zonal wind stress [R Z L T-2 ~> Pa] + real, intent(in) :: tau_y0 !< The meridional wind stress [R Z L T-2 ~> Pa] type(time_type), intent(in) :: day !< The time of the fluxes 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(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] - real :: mag_tau + real :: mag_tau ! Magnitude of the wind stress [R Z L T-2 ~> Pa] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_const, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z - !set steady surface wind stresses, in units of Pa. - mag_tau = Pa_conversion * sqrt( tau_x0**2 + tau_y0**2) + mag_tau = sqrt( tau_x0**2 + tau_y0**2) + ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = tau_x0 * Pa_conversion + forces%taux(I,j) = tau_x0 enddo ; enddo do J=js-1,Jeq ; do i=is,ie - forces%tauy(i,J) = tau_y0 * Pa_conversion + forces%tauy(i,J) = tau_y0 enddo ; enddo if (CS%read_gust_2d) then @@ -424,18 +424,21 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: PI + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] + real :: PI ! A common irrational number, 3.1415926535... [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_2gyre, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - !set the steady surface wind stresses, in units of Pa. + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z PI = 4.0*atan(1.0) + ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = 0.1*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + forces%taux(I,j) = 0.1 * Pa_to_RLZ_T2 * & (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) enddo ; enddo @@ -458,18 +461,21 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: PI + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] + real :: PI ! A common irrational number, 3.1415926535... [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_1gyre, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - ! set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + ! Set the steady surface wind stresses, in units of [R Z L T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = -0.2*US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & + forces%taux(I,j) = -0.2 * Pa_to_RLZ_T2 * & cos(PI*(G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat) enddo ; enddo @@ -491,22 +497,24 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: PI, y, I_rho + real :: PI ! A common irrational number, 3.1415926535... [nondim] + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] + real :: y ! The latitude relative to the south normalized by the domain extent [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - ! steady surface wind stresses [Pa] PI = 4.0*atan(1.0) + ! steady surface wind stresses [R L Z T-1 ~> Pa] do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat - forces%taux(I,j) = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z * & - (CS%gyres_taux_const + & - ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & - + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) )) + forces%taux(I,j) = CS%gyres_taux_const + & + ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) enddo ; enddo do J=js-1,Jeq ; do i=is-1,ie+1 @@ -546,9 +554,14 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: PI, I_rho, y - real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa] - real :: off + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] + real :: PI ! A common irrational number, 3.1415926535... [nondim] + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] + real :: y ! The latitude relative to the south normalized by the domain extent [nondim] + real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa] + real :: off ! An offset in the relative latitude [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -558,14 +571,15 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true.) - ! Set the surface wind stresses, in units of Pa. A positive taux + ! Set the surface wind stresses, in units of [R Z L T-2 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. PI = 4.0*atan(1.0) + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z forces%taux(:,:) = 0.0 - tau_max = 0.2 * US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + tau_max = 0.2 * Pa_to_RLZ_T2 off = 0.02 do j=js,je ; do I=is-1,Ieq y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat @@ -586,7 +600,7 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar is always positive. + ! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then I_rho = US%L_to_Z / CS%Rho0 do j=js,je ; do i=is,ie @@ -610,7 +624,10 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables integer :: i, j, kseg - real :: lon, lat, I_rho, y, L + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] + real :: y_curve ! The latitude relative to the southern end of a curve segment [degreesN] + real :: L_curve ! The latitudinal extent of a curve segment [degreesN] ! real :: ydata(7) = (/ -70., -45., -15., 0., 15., 45., 70. /) ! real :: taudt(7) = (/ 0., 0.2, -0.1, -0.02, -0.1, 0.1, 0. /) @@ -619,21 +636,18 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) kseg = 1 do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - lon = G%geoLonCu(I,j) - lat = G%geoLatCu(I,j) - - ! Find segment k s.t. ydata(k)<= lat < ydata(k+1) - do while (lat>=CS%scurves_ydata(kseg+1) .and. kseg<6) + ! Find segment k s.t. ydata(k)<= G%geoLatCu(I,j) < ydata(k+1) + do while (G%geoLatCu(I,j) >= CS%scurves_ydata(kseg+1) .and. kseg<6) ! Should this be kseg<19? kseg = kseg+1 enddo - do while (lat1) + do while (G%geoLatCu(I,j) < CS%scurves_ydata(kseg) .and. kseg>1) kseg = kseg-1 enddo - y = lat - CS%scurves_ydata(kseg) - L = CS%scurves_ydata(kseg+1) - CS%scurves_ydata(kseg) + y_curve = G%geoLatCu(I,j) - CS%scurves_ydata(kseg) + L_curve = CS%scurves_ydata(kseg+1) - CS%scurves_ydata(kseg) forces%taux(I,j) = CS%scurves_taux(kseg) + & - ( CS%scurves_taux(kseg+1) - CS%scurves_taux(kseg) ) * scurve(y, L) + (CS%scurves_taux(kseg+1) - CS%scurves_taux(kseg)) * scurve(y_curve, L_curve) forces%taux(I,j) = G%mask2dCu(I,j) * forces%taux(I,j) enddo ; enddo @@ -641,7 +655,7 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar is always positive. + ! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then I_rho = US%L_to_Z / CS%Rho0 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -655,9 +669,9 @@ end subroutine scurve_wind_forcing !> Returns the value of a cosine-bell function evaluated at x/L real function scurve(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: s + real , intent(in) :: x !< non-dimensional position [nondim] + real , intent(in) :: L !< non-dimensional width [nondim] + real :: s ! The evaluated function value [nondim] s = x/L scurve = (3. - 2.*s) * (s*s) @@ -675,10 +689,10 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables character(len=200) :: filename ! The name of the input file. - real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and pseudo-meridional - real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [R L Z T-1 ~> Pa]. - real :: Pa_conversion ! A unit conversion factor from Pa to the internal wind stress - ! units [R Z L T-2 Pa-1 ~> 1] + real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-1 ~> Pa] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-1 ~> Pa] + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and monthly cycles. integer :: time_lev ! The time level that is used for a field. @@ -689,7 +703,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) @@ -728,7 +742,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & temp_x(:,:), temp_y(:,:), G%Domain, stagger=AGRID, & - timelevel=time_lev, scale=Pa_conversion) + timelevel=time_lev, scale=Pa_to_RLZ_T2) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) do j=js,je ; do I=is-1,Ieq @@ -762,7 +776,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & temp_x(:,:), temp_y(:,:), & G%Domain_aux, stagger=CGRID_NE, timelevel=time_lev, & - scale=Pa_conversion) + scale=Pa_to_RLZ_T2) do j=js,je ; do i=is,ie forces%taux(I,j) = CS%wind_scale * temp_x(I,j) forces%tauy(i,J) = CS%wind_scale * temp_y(i,J) @@ -772,7 +786,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call MOM_read_vector(filename, CS%stress_x_var, CS%stress_y_var, & forces%taux(:,:), forces%tauy(:,:), & G%Domain, stagger=CGRID_NE, timelevel=time_lev, & - scale=Pa_conversion) + scale=Pa_to_RLZ_T2) if (CS%wind_scale /= 1.0) then do j=js,je ; do I=Isq,Ieq @@ -830,8 +844,9 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R Z L T-2 ~> Pa]. - real :: temp_y(SZI_(G),SZJ_(G)) ! Psuedo-meridional wind stresses at h-points [R Z L T-2 ~> Pa]. - real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R Z L T-2 ~> Pa]. + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: i, j call callTree_enter("wind_forcing_by_data_override, MOM_surface_forcing.F90") @@ -842,12 +857,12 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) CS%dataOverrideIsInitialized = .True. endif - Pa_conversion = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0 ! CS%wind_scale is ignored here because it is not set in this mode. - call data_override(G%Domain, 'taux', temp_x, day, scale=Pa_conversion) - call data_override(G%Domain, 'tauy', temp_y, day, scale=Pa_conversion) + call data_override(G%Domain, 'taux', temp_x, day, scale=Pa_to_RLZ_T2) + call data_override(G%Domain, 'tauy', temp_y, day, scale=Pa_to_RLZ_T2) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) do j=G%jsc,G%jec ; do I=G%isc-1,G%IecB forces%taux(I,j) = 0.5 * (temp_x(i,j) + temp_x(i+1,j)) @@ -857,7 +872,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) enddo ; enddo if (CS%read_gust_2d) then - call data_override(G%Domain, 'gust', CS%gust, day, scale=Pa_conversion) + call data_override(G%Domain, 'gust', CS%gust, day, scale=Pa_to_RLZ_T2) do j=G%jsc,G%jec ; do i=G%isc,G%iec forces%ustar(i,j) = sqrt((sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + & CS%gust(i,j)) * US%L_to_Z / CS%Rho0) @@ -891,17 +906,16 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) !! a previous surface_forcing_init call ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - temp, & ! A 2-d temporary work array with various units. - SST_anom, & ! Instantaneous sea surface temperature anomalies from a - ! target (observed) value [degC]. - SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target - ! (observed) value [ppt]. - SSS_mean ! A (mean?) salinity about which to normalize local salinity - ! anomalies when calculating restorative precipitation - ! anomalies [ppt]. - - real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling - ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. + temp ! A 2-d temporary work array in various units of [Q R Z T-1 ~> W m-2] or + ! [R Z T-1 ~> kg m-2 s-1] +!#CTRL# real, dimension(SZI_(G),SZJ_(G)) :: & +!#CTRL# SST_anom, & ! Instantaneous sea surface temperature anomalies from a +!#CTRL# ! target (observed) value [degC]. +!#CTRL# SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target +!#CTRL# ! (observed) value [ppt]. +!#CTRL# SSS_mean ! A (mean?) salinity about which to normalize local salinity +!#CTRL# ! anomalies when calculating restorative precipitation anomalies [ppt]. + real :: rhoXcp ! reference density times heat capacity [Q R degC-1 ~> J m-3 degC-1] integer :: time_lev_daily ! time levels to read for fields with daily cycle @@ -914,7 +928,6 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) call callTree_enter("buoyancy_forcing_from_files, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - kg_m2_s_conversion = US%kg_m2s_to_RZ_T if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p @@ -965,14 +978,14 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) end select if (CS%archaic_OMIP_file) then call MOM_read_data(CS%evaporation_file, CS%evap_var, fluxes%evap(:,:), & - G%Domain, timelevel=time_lev, scale=-kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=-US%kg_m2s_to_RZ_T) do j=js,je ; do i=is,ie fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) enddo ; enddo else call MOM_read_data(CS%evaporation_file, CS%evap_var, fluxes%evap(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) endif CS%evap_last_lev = time_lev @@ -1026,9 +1039,9 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) case default ; time_lev = 1 end select call MOM_read_data(CS%snow_file, CS%snow_var, & - fluxes%fprec(:,:), G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + fluxes%fprec(:,:), G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) call MOM_read_data(CS%rain_file, CS%rain_var, & - fluxes%lprec(:,:), G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + fluxes%lprec(:,:), G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) if (CS%archaic_OMIP_file) then do j=js,je ; do i=is,ie fluxes%lprec(i,j) = fluxes%lprec(i,j) - fluxes%fprec(i,j) @@ -1043,20 +1056,20 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) end select if (CS%archaic_OMIP_file) then call MOM_read_data(CS%runoff_file, CS%lrunoff_var, temp(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T*US%m_to_L**2) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) enddo ; enddo call MOM_read_data(CS%runoff_file, CS%frunoff_var, temp(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T*US%m_to_L**2) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) enddo ; enddo else call MOM_read_data(CS%runoff_file, CS%lrunoff_var, fluxes%lrunoff(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) call MOM_read_data(CS%runoff_file, CS%frunoff_var, fluxes%frunoff(:,:), & - G%Domain, timelevel=time_lev, scale=kg_m2_s_conversion) + G%Domain, timelevel=time_lev, scale=US%kg_m2s_to_RZ_T) endif CS%runoff_last_lev = time_lev @@ -1083,8 +1096,8 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) CS%buoy_last_lev_read = time_lev_daily ! mask out land points and compute heat content of water fluxes - ! assume liquid precip enters ocean at SST - ! assume frozen precip enters ocean at 0degC + ! assume liquid precipitation enters ocean at SST + ! assume frozen precipitation enters ocean at 0degC ! assume liquid runoff enters ocean at SST ! assume solid runoff (calving) enters ocean at 0degC ! mass leaving the ocean has heat_content determined in MOM_diabatic_driver.F90 @@ -1164,21 +1177,17 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: & - temp, & ! A 2-d temporary work array with various units. - SST_anom, & ! Instantaneous sea surface temperature anomalies from a - ! target (observed) value [degC]. - SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target - ! (observed) value [ppt]. - SSS_mean ! A (mean?) salinity about which to normalize local salinity - ! anomalies when calculating restorative precipitation - ! anomalies [ppt]. - real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling - ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. +!#CTRL# real, dimension(SZI_(G),SZJ_(G)) :: & +!#CTRL# SST_anom, & ! Instantaneous sea surface temperature anomalies from a +!#CTRL# ! target (observed) value [degC]. +!#CTRL# SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target +!#CTRL# ! (observed) value [ppt]. +!#CTRL# SSS_mean ! A (mean?) salinity about which to normalize local salinity +!#CTRL# ! anomalies when calculating restorative precipitation anomalies [ppt]. real :: rhoXcp ! The mean density times the heat capacity [Q R degC-1 ~> J m-3 degC-1]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed @@ -1186,7 +1195,6 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - kg_m2_s_conversion = US%kg_m2s_to_RZ_T if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p @@ -1208,10 +1216,10 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) enddo ; enddo - call data_override(G%Domain, 'snow', fluxes%fprec, day, scale=kg_m2_s_conversion) - call data_override(G%Domain, 'rain', fluxes%lprec, day, scale=kg_m2_s_conversion) - call data_override(G%Domain, 'runoff', fluxes%lrunoff, day, scale=kg_m2_s_conversion) - call data_override(G%Domain, 'calving', fluxes%frunoff, day, scale=kg_m2_s_conversion) + call data_override(G%Domain, 'snow', fluxes%fprec, day, scale=US%kg_m2s_to_RZ_T) + call data_override(G%Domain, 'rain', fluxes%lprec, day, scale=US%kg_m2s_to_RZ_T) + call data_override(G%Domain, 'runoff', fluxes%lrunoff, day, scale=US%kg_m2s_to_RZ_T) + call data_override(G%Domain, 'calving', fluxes%frunoff, day, scale=US%kg_m2s_to_RZ_T) ! Read the SST and SSS fields for damping. if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then @@ -1386,7 +1394,9 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: y, T_restore, S_restore + real :: y ! The latitude relative to the south normalized by the domain extent [nondim] + real :: T_restore ! The temperature towards which to restore [degC] + real :: S_restore ! The salinity towards which to restore [ppt] integer :: i, j, is, ie, js, je call callTree_enter("buoyancy_forcing_linear, MOM_surface_forcing.F90") @@ -1492,6 +1502,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! This include declares and sets the variable "version". # include "version_variable.h" real :: flux_const_default ! The unscaled value of FLUXCONST [m day-1] + real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units + ! for wind stresses [R Z L T-2 Pa-1 ~> 1] logical :: default_2018_answers character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=200) :: filename, gust_file ! The name of the gustiness input file. @@ -1509,6 +1521,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%diag => diag if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp + Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, '') call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & @@ -1706,17 +1720,17 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "With the gyres wind_config, the constant offset in the "//& "zonal wind stress profile: "//& " A in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0) - call get_param(param_file, mdl, "TAUX_SIN_AMP",CS%gyres_taux_sin_amp, & + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + call get_param(param_file, mdl, "TAUX_SIN_AMP", CS%gyres_taux_sin_amp, & "With the gyres wind_config, the sine amplitude in the "//& "zonal wind stress profile: "//& " B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0) - call get_param(param_file, mdl, "TAUX_COS_AMP",CS%gyres_taux_cos_amp, & + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) + call get_param(param_file, mdl, "TAUX_COS_AMP", CS%gyres_taux_cos_amp, & "With the gyres wind_config, the cosine amplitude in "//& "the zonal wind stress profile: "//& " C in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & - units="Pa", default=0.0) + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) call get_param(param_file, mdl, "TAUX_N_PIS",CS%gyres_taux_n_pis, & "With the gyres wind_config, the number of gyres in "//& "the zonal wind stress profile: "//& @@ -1741,7 +1755,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "WIND_SCURVES_TAUX", CS%scurves_taux, & "A list of zonal wind stress values at latitudes "//& "WIND_SCURVES_LATS defining a piecewise scurve profile.", & - units="Pa", fail_if_missing=.true.) + units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) endif if ((trim(CS%wind_config) == "2gyre") .or. & (trim(CS%wind_config) == "1gyre") .or. & @@ -1814,7 +1828,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", & - units="Pa", default=0.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) + units="Pa", default=0.0, scale=Pa_to_RLZ_T2) call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, & "If true correct a bug in the time-averaging of the gustless wind friction velocity", & default=.true.) @@ -1828,7 +1842,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) filename = trim(CS%inputdir) // trim(gust_file) call MOM_read_data(filename,'gustiness',CS%gust,G%domain, timelevel=1, & - scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa + scale=Pa_to_RLZ_T2) ! units in file should be Pa endif ! All parameter settings are now known. @@ -1846,11 +1860,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call idealized_hurricane_wind_init(Time, G, US, param_file, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then call get_param(param_file, mdl, "CONST_WIND_TAUX", CS%tau_x0, & - "With wind_config const, this is the constant zonal "//& - "wind-stress", units="Pa", fail_if_missing=.true.) + "With wind_config const, this is the constant zonal wind-stress", & + units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) call get_param(param_file, mdl, "CONST_WIND_TAUY", CS%tau_y0, & - "With wind_config const, this is the constant meridional "//& - "wind-stress", units="Pa", fail_if_missing=.true.) + "With wind_config const, this is the constant meridional wind-stress", & + units="Pa", scale=Pa_to_RLZ_T2, fail_if_missing=.true.) elseif (trim(CS%wind_config) == "SCM_CVmix_tests" .or. & trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_surface_forcing_init(Time, G, param_file, CS%SCM_CVmix_tests_CSp) @@ -1907,10 +1921,6 @@ subroutine surface_forcing_end(CS, fluxes) type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call type(forcing), optional, intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init, it will be deallocated here. -! (inout) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. if (present(fluxes)) call deallocate_forcing_type(fluxes) diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90 index 940bcd04b4..960cddf2ac 100644 --- a/config_src/drivers/solo_driver/user_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/user_surface_forcing.F90 @@ -27,7 +27,7 @@ module user_surface_forcing !! It can be readily modified for a specific case, and because it is private there !! will be no changes needed in other code (although they will have to be recompiled). type, public :: user_surface_forcing_CS ; private - ! The variables in the cannonical example are used for some common + ! The variables in the canonical example are used for some common ! cases, but do not need to be used. logical :: use_temperature !< If true, temperature and salinity are used as state variables. @@ -221,7 +221,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential - ! density [kg m-3] that is being restored toward. + ! density [R ~> kg m-3] that is being restored toward. density_restore = 1030.0*US%kg_m3_to_R fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & From 36d4f7f64d61a4e7c91d3ce3277073736bdfa15f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 4 Dec 2021 10:15:58 -0500 Subject: [PATCH 086/138] Bugfix: cpu clock sync error This patch fixes an error in the `sync` flag of the cpu clocks. Previously, we would set the sync bit of a flag based on the presence of sync, rather than testing if the value was true. This would cause potential hangs in any clock that set `sync`, including `.false.`. This patch correctly replaces the single `ibset` call with an if-block to either `ibset` or `ibclr`. --- config_src/infra/FMS1/MOM_cpu_clock_infra.F90 | 9 +++++++-- config_src/infra/FMS2/MOM_cpu_clock_infra.F90 | 9 +++++++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 index 62c21e5772..0c42c577b4 100644 --- a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 @@ -85,8 +85,13 @@ integer function cpu_clock_id(name, sync, grain) integer :: clock_flags clock_flags = clock_flag_default - if (present(sync)) & - clock_flags = ibset(clock_flags, 0) + if (present(sync)) then + if (sync) then + clock_flags = ibset(clock_flags, 0) + else + clock_flags = ibclr(clock_flags, 0) + endif + endif cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id diff --git a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 index 62c21e5772..0c42c577b4 100644 --- a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 @@ -85,8 +85,13 @@ integer function cpu_clock_id(name, sync, grain) integer :: clock_flags clock_flags = clock_flag_default - if (present(sync)) & - clock_flags = ibset(clock_flags, 0) + if (present(sync)) then + if (sync) then + clock_flags = ibset(clock_flags, 0) + else + clock_flags = ibclr(clock_flags, 0) + endif + endif cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id From e48f4a7f42f4e28cc5ac2b2dee5327617eeedec2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Dec 2021 10:58:13 -0500 Subject: [PATCH 087/138] +Add the new routine unit_no_scaling_init Added the public interface unit_no_scaling_init() to the MOM_unit_scaling module to initialize a non-scaling unit_scale_type without requiring a param_file_type argument. This should be useful for certain trivial unit tests, and it makes it more plausible to make the unit_scale_type arguments mandatory. As a part of this change, the new internal subroutine set_unit_scaling_combos() was carved out of unit_scaling_init to avoid code duplication. Also added comments describing the effective units of the various scaling factors with the standard MOM6 notation. All answers and output are bitwise identical. --- src/framework/MOM_unit_scaling.F90 | 93 ++++++++++++++++++++---------- 1 file changed, 63 insertions(+), 30 deletions(-) diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index dbcd2405ec..cd339f410c 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -8,39 +8,47 @@ module MOM_unit_scaling implicit none ; private -public unit_scaling_init, unit_scaling_end, fix_restart_unit_scaling +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, T, R and Q, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the rescaled +! combination is a nondimensional variable, the notation would be "a slope [Z L-1 ~> nondim]", +! but if (as the case for the variables here), the rescaled combination is exactly 1, the right +! notation would be something like "a dimensional scaling factor [Z m-1 ~> 1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. + +public unit_scaling_init, unit_no_scaling_init, unit_scaling_end, fix_restart_unit_scaling !> Describes various unit conversion factors type, public :: unit_scale_type - real :: m_to_Z !< A constant that translates distances in meters to the units of depth. - real :: Z_to_m !< A constant that translates distances in the units of depth to meters. - real :: m_to_L !< A constant that translates lengths in meters to the units of horizontal lengths. - real :: L_to_m !< A constant that translates lengths in the units of horizontal lengths to meters. - real :: s_to_T !< A constant that translates time intervals in seconds to the units of time. - real :: T_to_s !< A constant that translates the units of time to seconds. - real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. - real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. - real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram. - real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy. + real :: m_to_Z !< A constant that translates distances in meters to the units of depth [Z m-1 ~> 1] + real :: Z_to_m !< A constant that translates distances in the units of depth to meters [m Z-1 ~> 1] + real :: m_to_L !< A constant that translates lengths in meters to the units of horizontal lengths [L m-1 ~> 1] + real :: L_to_m !< A constant that translates lengths in the units of horizontal lengths to meters [m L-1 ~> 1] + real :: s_to_T !< A constant that translates time intervals in seconds to the units of time [T s-1 ~> 1] + real :: T_to_s !< A constant that translates the units of time to seconds [s T-1 ~> 1] + real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed [kg m-3 R-1 ~> 1] + real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density [R m3 kg-1 ~> 1] + real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram [J kg-1 Q-1 ~> 1] + real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy [Q kg J-1 ~> 1] ! These are useful combinations of the fundamental scale conversion factors above. - real :: Z_to_L !< Convert vertical distances to lateral lengths - real :: L_to_Z !< Convert lateral lengths to vertical distances - real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1. - real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1. - real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2. - real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1. - real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1. - real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1. - real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2. - ! Not used enough: real :: kg_m2_to_RZ !< Convert mass loads from kg m-2 to R Z. - real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2. - real :: kg_m2s_to_RZ_T !< Convert mass fluxes from kg m-2 s-1 to R Z T-1. - real :: RZ_T_to_kg_m2s !< Convert mass fluxes from R Z T-1 to kg m-2 s-1. - real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2. - real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3. - real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. - ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2. + real :: Z_to_L !< Convert vertical distances to lateral lengths [L Z-1 ~> 1] + real :: L_to_Z !< Convert lateral lengths to vertical distances [Z L-1 ~> 1] + real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1 [T m L-1 s-1 ~> 1] + real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1 [L s T-1 m-1 ~> 1] + real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2 [L s2 T-2 m-1 ~> 1] + real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1 [T1 m2 Z-2 s-1 ~> 1] + real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1 [Z2 s T-1 m-2 ~> 1] + real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1 [Q R Z m2 T-1 W-1 ~> 1] + real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2 [W T Q-1 R-1 Z-1 m-2 ~> 1] + ! Not used enough: real :: kg_m2_to_RZ !< Convert mass loads from kg m-2 to R Z [R Z m2 kg-1 ~> 1] + real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2 [kg R-1 Z-1 m-2 ~> 1] + real :: kg_m2s_to_RZ_T !< Convert mass fluxes from kg m-2 s-1 to R Z T-1 [R Z m2 s T-1 kg-1 ~> 1] + real :: RZ_T_to_kg_m2s !< Convert mass fluxes from R Z T-1 to kg m-2 s-1 [T kg R-1 Z-1 m-2 s-1 ~> 1] + real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2 [W T3 R-1 Z-3 m-2 ~> 1] + real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3 [R Z3 m2 T-3 W-1 ~> 1] + real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa [Pa T2 R-1 L-2 ~> 1] + ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2 [R L2 T-2 Pa-1 ~> 1] ! These are used for changing scaling across restarts. real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. @@ -130,7 +138,32 @@ subroutine unit_scaling_init( param_file, US ) US%Q_to_J_kg = 1.0 * Q_Rescale_factor US%J_kg_to_Q = 1.0 / Q_Rescale_factor - ! These are useful combinations of the fundamental scale conversion factors set above. + call set_unit_scaling_combos(US) +end subroutine unit_scaling_init + +!> Allocates and initializes the ocean model unit scaling type to unscaled values. +subroutine unit_no_scaling_init(US) + type(unit_scale_type), pointer :: US !< A dimensional unit scaling type + + if (associated(US)) call MOM_error(FATAL, & + 'unit_scaling_init: called with an associated US pointer.') + allocate(US) + + US%Z_to_m = 1.0 ; US%m_to_Z = 1.0 + US%L_to_m = 1.0 ; US%m_to_L = 1.0 + US%T_to_s = 1.0 ; US%s_to_T = 1.0 + US%R_to_kg_m3 = 1.0 ; US%kg_m3_to_R = 1.0 + US%Q_to_J_kg = 1.0 ; US%J_kg_to_Q = 1.0 + + call set_unit_scaling_combos(US) +end subroutine unit_no_scaling_init + +!> This subroutine sets useful combinations of the fundamental scale conversion factors +!! in the unit scaling type. +subroutine set_unit_scaling_combos(US) + type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type + + ! Convert vertical to horizontal length scales and the reverse: US%Z_to_L = US%Z_to_m * US%m_to_L US%L_to_Z = US%L_to_m * US%m_to_Z ! Horizontal velocities: @@ -159,7 +192,7 @@ subroutine unit_scaling_init( param_file, US ) ! It does not seem like US%Pa_to_RL2_T2 would be used enough in MOM6 to justify its existence. ! US%Pa_to_RL2_T2 = US%kg_m3_to_R * US%m_s_to_L_T**2 -end subroutine unit_scaling_init +end subroutine set_unit_scaling_combos !> Set the unit scaling factors for output to restart files to the unit scaling !! factors for this run. From 59c592649bc404cf933b88b988077f7ecdf9bd65 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Dec 2021 11:50:39 -0500 Subject: [PATCH 088/138] (*)Provide US arguments to 4 existing calls Provide optional US arguments to 4 existing calls to set_grid_metrics() and MOM_initialize_topography(), enabling these arguments to become mandatory in the next commit. In some cases this requires a call to unit_no_scaling_init() or the removal of a call to rescale_dyn_horgrid_bathymetry(). In addition, a mis-scaled value was corrected in the initialization of the ODA control structures private thickness array; this latter issue is not a problem for Boussinesq models without dimensional rescaling (i.e. the tested cases), but could change answers in other cases with data assimilation. All answers in the MOM6-examples or TC test cases are bitwise identical. --- config_src/drivers/unit_drivers/MOM_sum_driver.F90 | 7 ++++++- src/ice_shelf/MOM_ice_shelf.F90 | 6 ++---- src/ocean_data_assim/MOM_oda_driver.F90 | 8 ++++---- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index 7291eb913a..9f3950ac7f 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -29,6 +29,7 @@ program MOM_main use MOM_io, only : MOM_io_init, file_exists, open_file, close_file use MOM_io, only : check_nml_error, io_infra_init, io_infra_end use MOM_io, only : APPEND_FILE, ASCII_FILE, READONLY_FILE, SINGLE_FILE + use MOM_unit_scaling, only : unit_scale_type, unit_no_scaling_init, unit_scaling_end implicit none @@ -39,6 +40,8 @@ program MOM_main type(hor_index_type) :: HI ! A hor_index_type for array extents type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. + type(unit_scale_type), pointer :: US => NULL() !< A structure containing various unit + ! conversion factors, but in this case all are 1. real :: max_depth ! The maximum ocean depth [m] integer :: verbosity integer :: num_sums @@ -104,7 +107,8 @@ program MOM_main allocate(depth_tot_fastR(num_sums)) ; depth_tot_fastR(:) = 0.0 ! Set up the parameters of the physical grid - call set_grid_metrics(grid, param_file) + call unit_no_scaling_init(US) + call set_grid_metrics(grid, param_file, US) ! Set up the bottom depth, grid%bathyT either analytically or from file call get_param(param_file, "MOM", "MAXIMUM_DEPTH", max_depth, & @@ -162,6 +166,7 @@ program MOM_main enddo call destroy_dyn_horgrid(grid) + call unit_scaling_end(US) call io_infra_end ; call MOM_infra_end contains diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 77166cece0..674b84807d 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -21,7 +21,6 @@ module MOM_ice_shelf use MOM_domains, only : MOM_domains_init, pass_var, pass_vector, clone_MOM_domain use MOM_domains, only : TO_ALL, CGRID_NE, BGRID_NE, CORNER use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid -use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_grid, only : MOM_grid_init, ocean_grid_type @@ -1306,9 +1305,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call create_dyn_horgrid(dG, CS%Grid%HI) call clone_MOM_domain(CS%Grid%Domain,dG%Domain) call set_grid_metrics(dG,param_file,CS%US) - ! Set up the bottom depth, G%D either analytically or from file - call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file) - call rescale_dyn_horgrid_bathymetry(dG, CS%US%Z_to_m) + ! Set up the bottom depth, dG%bathyT, either analytically or from file + call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file, CS%US) call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) call destroy_dyn_horgrid(dG) ! endif diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 161cf16115..d5259d760a 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -278,8 +278,8 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) allocate(dG) call create_dyn_horgrid(dG, HI) call clone_MOM_domain(CS%Grid%Domain, dG%Domain,symmetric=.false.) - call set_grid_metrics(dG,PF) - call MOM_initialize_topography(dg%bathyT,dG%max_depth,dG,PF) + call set_grid_metrics(dG, PF, CS%US) + call MOM_initialize_topography(dG%bathyT, dG%max_depth, dG, PF, CS%US) call MOM_initialize_coord(CS%GV, CS%US, PF, .false., & dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) @@ -313,9 +313,9 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) !jsd=jsd+jdg_offset; jed=jed+jdg_offset ! TODO: switch to local indexing? (mjh) if (.not. associated(CS%h)) then - allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_m*CS%GV%H_to_m) + allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_H) ! assign thicknesses - call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) + call ALE_initThicknessToCoord(CS%ALE_CS, G, CS%GV, CS%h) endif allocate(CS%tv) allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke), source=0.0) From 3162bd08690b518633ab66bd8c37ebe3125616d6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Dec 2021 11:57:20 -0500 Subject: [PATCH 089/138] +Make US arguments non-optional for 28 routines Made the unit_scale_type arguments non-optional for 28 routines. These arguments had been optional in the first place to manage the coordination between the MOM6 and SIS2 repositories, but SIS2 has been using these optional arguments for several years now, and they can be made mandatory without imposing any disruptions. This change simplifies and clarifies the code. All answers and output are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 8 +- .../MOM_fixed_initialization.F90 | 15 +- src/initialization/MOM_grid_initialize.F90 | 105 +++----- .../MOM_shared_initialization.F90 | 252 +++++++----------- .../MOM_state_initialization.F90 | 2 +- src/user/DOME_initialization.F90 | 15 +- src/user/ISOMIP_initialization.F90 | 15 +- src/user/Kelvin_initialization.F90 | 11 +- src/user/Phillips_initialization.F90 | 10 +- src/user/benchmark_initialization.F90 | 13 +- src/user/shelfwave_initialization.F90 | 15 +- src/user/user_initialization.F90 | 6 +- 12 files changed, 189 insertions(+), 278 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index be00de8779..917a4afdc3 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -92,23 +92,21 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type, which is + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type, which is !! used to rescale u and v if present. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully !! symmetric computational domain. - real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> 1] or [1] + integer :: hs logical :: sym - 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 - call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=L_T_to_m_s) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index b67d21ebcb..f0fb1d23f9 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -6,7 +6,7 @@ module MOM_fixed_initialization use MOM_debugging, only : hchksum, qchksum, uvchksum use MOM_domains, only : pass_var -use MOM_dyn_horgrid, only : dyn_horgrid_type, rescale_dyn_horgrid_bathymetry +use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, read_param, log_param, param_file_type @@ -82,7 +82,6 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF, US) -! call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) @@ -174,20 +173,16 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) intent(out) :: D !< Ocean bottom depth [Z ~> m] or [m] type(param_file_type), intent(in) :: PF !< Parameter file structure real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] or [m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. ! Local variables - real :: m_to_Z, Z_to_m ! Dimensional rescaling factors character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - Z_to_m = 1.0 ; if (present(US)) Z_to_m = US%Z_to_m - call get_param(PF, mdl, "TOPO_CONFIG", config, & "This specifies how bathymetry is specified: \n"//& " \t file - read bathymetric information from the file \n"//& @@ -216,7 +211,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) " \t dense - Denmark Strait-like dense water formation and overflow.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=.true.) - max_depth = -1.e9*m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=m_to_Z) + max_depth = -1.e9*US%m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=US%m_to_Z) select case ( trim(config) ) case ("file"); call initialize_topography_from_file(D, G, PF, US) case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) @@ -241,11 +236,11 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) "Unrecognized topography setup '"//trim(config)//"'") end select if (max_depth>0.) then - call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*Z_to_m, & + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*US%Z_to_m, & "The maximum depth of the ocean.", units="m") else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*Z_to_m, & + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*US%Z_to_m, & "The (diagnosed) maximum depth of the ocean.", units="m", like_default=.true.) endif if (trim(config) /= "DOME") then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index f67a977d27..498e1915ba 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -58,19 +58,14 @@ module MOM_grid_initialize subroutine set_grid_metrics(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_L ! A length unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A length unit conversion factor [m L-1 ~> 1] ! This include declares and sets the variable "version". # include "version_variable.h" logical :: debug character(len=256) :: config - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - call callTree_enter("set_grid_metrics(), MOM_grid_initialize.F90") call log_version(param_file, "MOM_grid_init", version, "") call get_param(param_file, "MOM_grid_init", "GRID_CONFIG", config, & @@ -88,7 +83,7 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" - G%Rad_Earth_L = -1.0*m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 + G%Rad_Earth_L = -1.0*US%m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 select case (trim(config)) case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) @@ -104,11 +99,11 @@ subroutine set_grid_metrics(G, param_file, US) ! The grid metrics were set with an option that does not explicitly initialize Rad_Earth. ! ### Rad_Earth should be read as in: ! call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & - ! "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + ! "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) ! but for now it is being set via a hard-coded value to reproduce current behavior. - G%Rad_Earth_L = 6.378e6*m_to_L + G%Rad_Earth_L = 6.378e6*US%m_to_L endif - G%Rad_Earth = L_to_m*G%Rad_Earth_L + G%Rad_Earth = US%L_to_m*G%Rad_Earth_L ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") @@ -127,39 +122,35 @@ end subroutine set_grid_metrics subroutine grid_metrics_chksum(parent, G, US) character(len=*), intent(in) :: parent !< A string identifying the caller type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] integer :: halo - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m halo = min(G%ied-G%iec, G%jed-G%jec, 1) call hchksum_pair(trim(parent)//': d[xy]T', G%dxT, G%dyT, G%HI, & - haloshift=halo, scale=L_to_m, scalar_pair=.true.) + haloshift=halo, scale=US%L_to_m, scalar_pair=.true.) - call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) + call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=US%L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) + call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=US%L_to_m) - call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) + call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=US%L_to_m) call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, & - haloshift=halo, scale=m_to_L, scalar_pair=.true.) + haloshift=halo, scale=US%m_to_L, scalar_pair=.true.) - call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=m_to_L) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=US%m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=US%m_to_L) - call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=m_to_L) + call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=US%m_to_L) - call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=L_to_m**2) - call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=L_to_m**2) + call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=US%L_to_m**2) + call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=US%L_to_m**2) - call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=m_to_L**2) - call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=m_to_L**2) + call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=US%m_to_L**2) + call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=US%m_to_L**2) call hchksum(G%geoLonT,trim(parent)//': geoLonT',G%HI, haloshift=halo) call hchksum(G%geoLatT,trim(parent)//': geoLatT',G%HI, haloshift=halo) @@ -178,8 +169,8 @@ end subroutine grid_metrics_chksum !> Sets the grid metrics from a mosaic file. subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4 real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4 @@ -197,7 +188,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" type(MOM_domain_type), pointer :: SGdom => NULL() ! Supergrid domain @@ -207,7 +197,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) @@ -331,16 +320,16 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call pass_var(areaBu, G%Domain, position=CORNER) do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) + G%dxT(i,j) = US%m_to_L*dxT(i,j) ; G%dyT(i,j) = US%m_to_L*dyT(i,j) ; G%areaT(i,j) = US%m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = m_to_L*dyCu(I,j) + G%dxCu(I,j) = US%m_to_L*dxCu(I,j) ; G%dyCu(I,j) = US%m_to_L*dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) + G%dxCv(i,J) = US%m_to_L*dxCv(i,J) ; G%dyCv(i,J) = US%m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = m_to_L*dxBu(I,J) ; G%dyBu(I,J) = m_to_L*dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) + G%dxBu(I,J) = US%m_to_L*dxBu(I,J) ; G%dyBu(I,J) = US%m_to_L*dyBu(I,J) ; G%areaBu(I,J) = US%m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -395,8 +384,8 @@ end subroutine set_grid_metrics_from_mosaic !! sets of points. subroutine set_grid_metrics_cartesian(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal @@ -405,7 +394,6 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) real :: dx_everywhere, dy_everywhere ! Grid spacings [L ~> m]. real :: I_dx, I_dy ! Inverse grid spacings [L-1 ~> m-1]. real :: PI - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -416,7 +404,6 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & @@ -438,7 +425,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) "The longitudinal or x-direction length of the domain.", & units=units_temp, fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" @@ -476,11 +463,11 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) enddo if (units_temp(1:1) == 'k') then ! Axes are measured in km. - dx_everywhere = 1000.0*m_to_L * G%len_lon / (REAL(niglobal)) - dy_everywhere = 1000.0*m_to_L * G%len_lat / (REAL(njglobal)) + dx_everywhere = 1000.0*US%m_to_L * G%len_lon / (REAL(niglobal)) + dy_everywhere = 1000.0*US%m_to_L * G%len_lat / (REAL(njglobal)) elseif (units_temp(1:1) == 'm') then ! Axes are measured in m. - dx_everywhere = m_to_L*G%len_lon / (REAL(niglobal)) - dy_everywhere = m_to_L*G%len_lat / (REAL(njglobal)) + dx_everywhere = US%m_to_L*G%len_lon / (REAL(niglobal)) + dy_everywhere = US%m_to_L*G%len_lat / (REAL(njglobal)) else ! Axes are measured in degrees of latitude and longitude. dx_everywhere = G%Rad_Earth_L * G%len_lon * PI / (180.0 * niglobal) dy_everywhere = G%Rad_Earth_L * G%len_lat * PI / (180.0 * njglobal) @@ -531,8 +518,8 @@ end subroutine set_grid_metrics_cartesian !! sets of points. subroutine set_grid_metrics_spherical(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed @@ -541,7 +528,6 @@ subroutine set_grid_metrics_spherical(G, param_file, US) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -551,7 +537,6 @@ subroutine set_grid_metrics_spherical(G, param_file, US) i_offset = G%idg_offset ; j_offset = G%jdg_offset call callTree_enter("set_grid_metrics_spherical(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. @@ -570,7 +555,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) dLon = G%len_lon/G%Domain%niglobal dLat = G%len_lat/G%Domain%njglobal @@ -670,8 +655,8 @@ end subroutine set_grid_metrics_spherical !! sets of points. subroutine set_grid_metrics_mercator(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off @@ -691,7 +676,6 @@ subroutine set_grid_metrics_mercator(G, param_file, US) real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is real :: jRef, iRef ! being set to be at grid index jRef or iRef. - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] integer :: itt1, itt2 logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -710,7 +694,6 @@ subroutine set_grid_metrics_mercator(G, param_file, US) call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI @@ -728,7 +711,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) G%south_lat = GP%south_lat ; G%len_lat = GP%len_lat G%west_lon = GP%west_lon ; G%len_lon = GP%len_lon G%Rad_Earth_L = GP%Rad_Earth_L @@ -1210,11 +1193,10 @@ end function Adcroft_reciprocal !! any land or boundary point. For points in the interior, mask2dCu, !! mask2dCv, and mask2dBu are all 1.0. subroutine initialize_masks(G, PF, US) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: PF !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z_scale ! A unit conversion factor from m to Z [Z m-1 ~> 1] real :: Dmask ! The depth for masking in the same units as G%bathyT [Z ~> m]. real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. @@ -1222,22 +1204,21 @@ subroutine initialize_masks(G, PF, US) integer :: i, j call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") - m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z_scale) + units="m", default=0.0, scale=US%m_to_Z) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z_scale) + units="m", default=-9999.0, scale=US%m_to_Z) Dmask = mask_depth - if (mask_depth == -9999.*m_to_Z_scale) Dmask = min_depth + if (mask_depth == -9999.0*US%m_to_Z) Dmask = min_depth G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 9973b64a21..bb5a84033b 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -57,7 +57,7 @@ subroutine MOM_initialize_rotation(f, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [T-1 ~> s-1] type(param_file_type), intent(in) :: PF !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the Coriolis parameter. ! This is a separate subroutine so that it can be made public and shared with @@ -95,11 +95,8 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] real :: f1, f2 - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & (LBOUND(G%CoriolisBu,2) > G%isc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. @@ -139,19 +136,16 @@ end function diagnoseMaximumDepth subroutine initialize_topography_from_file(D, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. character(len=200) :: filename, topo_file, inputdir ! Strings for file/path character(len=200) :: topo_varname ! Variable name in file character(len=40) :: mdl = "initialize_topography_from_file" ! This subroutine's name. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_FILE", topo_file, & @@ -167,13 +161,13 @@ subroutine initialize_topography_from_file(D, G, param_file, US) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) - D(:,:) = -9.e30*m_to_Z ! Initializing to a very large negative depth (tall mountains) everywhere + D(:,:) = -9.0e30*US%m_to_Z ! Initializing to a very large negative depth (tall mountains) everywhere ! before reading from a file should do nothing. However, in the instance of ! masked-out PEs, halo regions are not updated when a processor does not ! exist. We need to ensure the depth in masked-out PEs appears to be that ! of land so this line does that in the halo regions. For non-masked PEs ! the halo region is filled properly with a later pass_var(). - call MOM_read_data(filename, trim(topo_varname), D, G%Domain, scale=m_to_Z) + call MOM_read_data(filename, trim(topo_varname), D, G%Domain, scale=US%m_to_Z) call apply_topography_edits_from_file(D, G, param_file, US) @@ -187,10 +181,9 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) intent(inout) :: D !< Ocean bottom depth [m] or [Z ~> m] if !! US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real, dimension(:), allocatable :: new_depth ! The new values of the depths [m] integer, dimension(:), allocatable :: ig, jg ! The global indicies of the points to modify character(len=200) :: topo_edits_file, inputdir ! Strings for file/path @@ -202,8 +195,6 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & @@ -217,13 +208,13 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z) - if (mask_depth == -9999.*m_to_Z) mask_depth = min_depth + units="m", default=-9999.0, scale=US%m_to_Z) + if (mask_depth == -9999.*US%m_to_Z) mask_depth = min_depth if (len_trim(topo_edits_file)==0) return @@ -263,15 +254,15 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) i = ig(n) - G%isd_global + 2 ! +1 for python indexing and +1 for ig-isd_global+1 j = jg(n) - G%jsd_global + 2 if (i>=G%isc .and. i<=G%iec .and. j>=G%jsc .and. j<=G%jec) then - if (new_depth(n)*m_to_Z /= mask_depth) then + if (new_depth(n)*US%m_to_Z /= mask_depth) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & - 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j - D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)*US%Z_to_m, '->', abs(new_depth(n)), i, j + D(i,j) = abs(US%m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else if (topo_edits_change_mask) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & - 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j - D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)*US%Z_to_m,'->',abs(new_depth(n)),i,j + D(i,j) = abs(US%m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& "A zero depth edit would change the land mask and is not allowed in"//trim(topo_edits_file)) @@ -289,18 +280,16 @@ end subroutine apply_topography_edits_from_file subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure character(len=*), intent(in) :: topog_config !< The name of an idealized !! topographic configuration - real, intent(in) :: max_depth !< Maximum depth of model in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine places the bottom depth in m into D(:,:), shaped according to the named config. ! Local variables - real :: m_to_Z ! A dimensional rescaling factor [Z m-1 ~> 1] - real :: m_to_L ! A dimensional rescaling factor [L m-1 ~> 1] real :: min_depth ! The minimum depth [Z ~> m]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] @@ -315,21 +304,18 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth call MOM_mesg(" MOM_shared_initialization.F90, initialize_topography_named: "//& "TOPO_CONFIG = "//trim(topog_config), 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) if (max_depth<=0.) call MOM_error(FATAL,"initialize_topography_named: "// & "MAXIMUM_DEPTH has a non-sensical value! Was it set?") if (trim(topog_config) /= "flat") then call get_param(param_file, mdl, "EDGE_DEPTH", Dedge, & "The depth at the edge of one of the named topographies.", & - units="m", default=100.0, scale=m_to_Z) + units="m", default=100.0, scale=US%m_to_Z) call get_param(param_file, mdl, "TOPOG_SLOPE_SCALE", expdecay, & "The exponential decay scale used in defining some of "//& - "the named topographies.", units="m", default=400000.0, scale=m_to_L) + "the named topographies.", units="m", default=400000.0, scale=US%m_to_L) endif @@ -389,13 +375,12 @@ end subroutine initialize_topography_named subroutine limit_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(inout) :: D !< Ocean bottom depth in m or Z if US is present + intent(inout) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum depth of model [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j character(len=40) :: mdl = "limit_topography" ! This subroutine's name. real :: min_depth ! The shallowest value of wet points [Z ~> m] @@ -403,24 +388,22 @@ subroutine limit_topography(D, G, param_file, max_depth, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z, do_not_log=.true.) + units="m", default=-9999.0, scale=US%m_to_Z, do_not_log=.true.) ! Make sure that min_depth < D(x,y) < max_depth for ocean points ! TBD: The following f.p. equivalence uses a special value. Originally, any negative value ! indicated the branch. We should create a logical flag to indicate this branch. - if (mask_depth == -9999.*m_to_Z) then + if (mask_depth == -9999.*US%m_to_Z) then if (min_depth<0.) then call MOM_error(FATAL, trim(mdl)//": MINIMUM_DEPTH<0 does not work as expected "//& "unless MASKING_DEPTH has been set appropriately. Set a meaningful "//& @@ -460,22 +443,19 @@ subroutine set_rotation_planetary(f, G, param_file, US) real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J real :: PI real :: omega ! The planetary rotation rate [T-1 ~> s-1] - real :: T_to_s ! A time unit conversion factor call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s - call get_param(param_file, "set_rotation_planetary", "OMEGA", omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=T_to_s) + default=7.2921e-5, scale=US%T_to_s) PI = 4.0*atan(1.0) do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB @@ -493,7 +473,7 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J @@ -502,9 +482,6 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] real :: Rad_Earth_L ! The radius of the planet in rescaled units [L ~> m] real :: y_scl ! A scaling factor from the units of latitude [L lat-1 ~> m lat-1] - real :: T_to_s ! A time unit conversion factor [s T-1 ~> 1] - real :: m_to_L ! A length unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A length unit conversion factor [m L-1 ~> 1] real :: PI character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units @@ -512,31 +489,27 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - call get_param(param_file, mdl, "F_0", f_0, & "The reference value of the Coriolis parameter with the "//& - "betaplane option.", units="s-1", default=0.0, scale=T_to_s) + "betaplane option.", units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "BETA", beta, & "The northward gradient of the Coriolis parameter with "//& - "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s*L_to_m) + "the betaplane option.", units="m-1 s-1", default=0.0, scale=US%T_to_s*US%L_to_m) call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") PI = 4.0*atan(1.0) select case (axis_units(1:1)) case ("d") call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) beta_lat_ref_units = "degrees" y_scl = PI * Rad_Earth_L / 180. case ("k") beta_lat_ref_units = "kilometers" - y_scl = 1.E3 * m_to_L + y_scl = 1.0e3 * US%m_to_L case ("m") beta_lat_ref_units = "meters" - y_scl = 1. * m_to_L + y_scl = 1.0 * US%m_to_L case default ; call MOM_error(FATAL, & " set_rotation_beta_plane: unknown AXIS_UNITS = "//trim(axis_units)) end select @@ -633,90 +606,89 @@ subroutine reset_face_lengths_named(G, param_file, name, US) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters character(len=*), intent(in) :: name !< The name for the set of face lengths. Only "global_1deg" !! is currently implemented. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=256) :: mesg ! Message for error messages. - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] - real :: dx_2 = -1.0, dy_2 = -1.0 + real :: dx_2 ! Half the local zonal grid spacing [degreesE] + real :: dy_2 ! Half the local meridional grid spacing [degreesN] real :: pi_180 - integer :: option = -1 + integer :: option integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB pi_180 = (4.0*atan(1.0))/180.0 + dx_2 = -1.0 ; dy_2 = -1.0 + option = -1 + select case ( trim(name) ) case ("global_1deg") ; option = 1 ; dx_2 = 0.5*1.0 case default ; call MOM_error(FATAL, "reset_face_lengths_named: "//& "Unrecognized channel configuration name "//trim(name)) end select - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*m_to_L ! Gibraltar + G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*US%m_to_L ! Gibraltar if ((abs(G%geoLatCu(I,j)-12.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-43.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*m_to_L ! Red Sea + G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*US%m_to_L ! Red Sea if ((abs(G%geoLatCu(I,j)-40.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-26.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*m_to_L ! Dardanelles + G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*US%m_to_L ! Dardanelles if ((abs(G%geoLatCu(I,j)-41.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+220.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*m_to_L ! Tsugaru strait at 140.0e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*US%m_to_L ! Tsugaru strait at 140.0e if ((abs(G%geoLatCu(I,j)-45.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+217.5) < 0.9)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*US%m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCu(I,j)-80.84) < 0.2) .and. (abs(G%geoLonCu(I,j)+64.9) < 0.8)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*m_to_L ! Smith Sound in Canadian Arch - tripolar region + G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*US%m_to_L ! Smith Sound in Canadian Arch - tripolar region enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*US%m_to_L ! Bosporus - should be 1000.0 m wide. if ((abs(G%geoLatCv(i,J)-13.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-42.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*m_to_L ! Red Sea + G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*US%m_to_L ! Red Sea if ((abs(G%geoLatCv(i,J)+2.8) < 0.8) .and. (abs(G%geoLonCv(i,J)+241.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*m_to_L ! Makassar Straits at 241.5 W = 118.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*US%m_to_L ! Makassar Straits at 241.5 W = 118.5 E if ((abs(G%geoLatCv(i,J)-0.56) < 0.5) .and. (abs(G%geoLonCv(i,J)+240.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*US%m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+230.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+229.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E if ((abs(G%geoLatCv(i,J)-0.0) < 0.25) .and. (abs(G%geoLonCv(i,J)+228.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+244.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Lombok Straits at 244.5 W = 115.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*US%m_to_L ! Lombok Straits at 244.5 W = 115.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+235.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Timor Straits at 235.5 W = 124.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*US%m_to_L ! Timor Straits at 235.5 W = 124.5 E if ((abs(G%geoLatCv(i,J)-52.5) < dy_2) .and. (abs(G%geoLonCv(i,J)+218.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*US%m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCv(i,J)-76.8) < 0.06) .and. (abs(G%geoLonCv(i,J)+88.7) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*m_to_L ! Jones Sound in Canadian Arch - tripolar region + G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*US%m_to_L ! Jones Sound in Canadian Arch - tripolar region enddo ; enddo endif @@ -724,10 +696,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! These checks apply regardless of the chosen option. do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then + if (G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & + US%L_to_m*G%dy_Cu(I,j), US%L_to_m*G%dyCu(I,j), US%L_to_m*(G%dy_Cu(I,j)-G%dyCu(I,j)), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif @@ -737,10 +709,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then + if (G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & + US%L_to_m*G%dx_Cv(i,J), US%L_to_m*G%dxCv(i,J), US%L_to_m*(G%dx_Cv(i,J)-G%dxCv(i,J)), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) @@ -759,22 +731,18 @@ end subroutine reset_face_lengths_named subroutine reset_face_lengths_file(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -789,14 +757,14 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=m_to_L) + call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=US%m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then + if (G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & + US%L_to_m*G%dy_Cu(I,j), US%L_to_m*G%dyCu(I,j), US%L_to_m*(G%dy_Cu(I,j)-G%dyCu(I,j)), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif @@ -806,10 +774,10 @@ subroutine reset_face_lengths_file(G, param_file, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then + if (G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & + US%L_to_m*G%dx_Cv(i,J), US%L_to_m*G%dxCv(i,J), US%L_to_m*(G%dx_Cv(i,J)-G%dxCv(i,J)), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) @@ -829,7 +797,7 @@ end subroutine reset_face_lengths_file subroutine reset_face_lengths_list(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=120), pointer, dimension(:) :: lines => NULL() @@ -847,9 +815,6 @@ subroutine reset_face_lengths_list(G, param_file, US) Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] real, allocatable, dimension(:) :: & Dmin_v, Dmax_v, Davg_v - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] - real :: m_to_Z ! A unit conversion factor [Z m-1 ~> 1] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -870,9 +835,6 @@ subroutine reset_face_lengths_list(G, param_file, US) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -1053,10 +1015,10 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(m_to_L*u_width(npt), 0.0)) - G%porous_DminU(I,j) = m_to_Z*Dmin_u(npt) - G%porous_DmaxU(I,j) = m_to_Z*Dmax_u(npt) - G%porous_DavgU(I,j) = m_to_Z*Davg_u(npt) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(US%m_to_L*u_width(npt), 0.0)) + G%porous_DminU(I,j) = US%m_to_Z*Dmin_u(npt) + G%porous_DmaxU(I,j) = US%m_to_Z*Dmax_u(npt) + G%porous_DavgU(I,j) = US%m_to_Z*Davg_u(npt) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then @@ -1066,7 +1028,7 @@ subroutine reset_face_lengths_list(G, param_file, US) u_line_used(npt) = u_line_used(npt) + 1 write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& - u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",L_to_m*G%dy_Cu(I,j),"m" + u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",US%L_to_m*G%dy_Cu(I,j),"m" write(stdout,'(A,3F8.2,A)') & "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminU(I,j),& G%porous_DmaxU(I,j), G%porous_DavgU(I,j),")m" @@ -1090,10 +1052,10 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(m_to_L*v_width(npt), 0.0)) - G%porous_DminV(i,J) = m_to_Z*Dmin_v(npt) - G%porous_DmaxV(i,J) = m_to_Z*Dmax_v(npt) - G%porous_DavgV(i,J) = m_to_Z*Davg_v(npt) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(US%m_to_L*v_width(npt), 0.0)) + G%porous_DminV(i,J) = US%m_to_Z*Dmin_v(npt) + G%porous_DmaxV(i,J) = US%m_to_Z*Dmax_v(npt) + G%porous_DavgV(i,J) = US%m_to_Z*Davg_v(npt) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then @@ -1103,7 +1065,7 @@ subroutine reset_face_lengths_list(G, param_file, US) v_line_used(npt) = v_line_used(npt) + 1 write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& - v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",L_to_m*G%dx_Cv(I,j),"m" + v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",US%L_to_m*G%dx_Cv(I,j),"m" write(stdout,'(A,3F8.2,A)') & "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminV(i,J),& G%porous_DmaxV(i,J), G%porous_DavgV(i,J),")m" @@ -1247,15 +1209,15 @@ end subroutine set_velocity_depth_min !> Pre-compute global integrals of grid quantities (like masked ocean area) for !! later use in reporting diagnostics subroutine compute_global_grid_integrals(G, US) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming - real :: area_scale ! A scaling factor for area into MKS units + real :: area_scale ! A scaling factor for area into MKS units [m2 L-2 ~> 1] integer :: i,j - area_scale = 1.0 ; if (present(US)) area_scale = US%L_to_m**2 + area_scale = US%L_to_m**2 tmpForSumming(:,:) = 0. G%areaT_global = 0.0 ; G%IareaT_global = 0.0 @@ -1275,13 +1237,13 @@ end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- !> Write out a file describing the topography, Coriolis parameter, grid locations !! and various other fixed fields from the grid. -subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) +subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< Parameter file structure character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file !! (otherwise the file is "ocean_geometry") - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables. character(len=240) :: filepath ! The full path to the file to write @@ -1290,9 +1252,6 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) vars ! Types with metadata about the variables and their staggering type(fieldtype), dimension(:), allocatable :: & fields ! Opaque types used by MOM_io to store variable metadata information - real :: Z_to_m_scale ! A unit conversion factor from Z to m - real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1 - real :: L_to_m_scale ! A unit conversion factor from L to m type(file_type) :: IO_handle ! The I/O handle of the fileset integer :: nFlds ! The number of variables in this file integer :: file_threading @@ -1300,11 +1259,6 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call callTree_enter('write_ocean_geometry_file()') - Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m - s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T - L_to_m_scale = 1.0 ; if (present(US)) L_to_m_scale = US%L_to_m - - nFlds = 19 ; if (G%bathymetry_at_vel) nFlds = 23 allocate(vars(nFlds)) @@ -1369,30 +1323,30 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call MOM_write_field(IO_handle, fields(3), G%Domain, G%geoLatT) call MOM_write_field(IO_handle, fields(4), G%Domain, G%geoLonT) - call MOM_write_field(IO_handle, fields(5), G%Domain, G%bathyT, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(6), G%Domain, G%CoriolisBu, scale=s_to_T_scale) + call MOM_write_field(IO_handle, fields(5), G%Domain, G%bathyT, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(6), G%Domain, G%CoriolisBu, scale=US%s_to_T) - call MOM_write_field(IO_handle, fields(7), G%Domain, G%dxCv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(8), G%Domain, G%dyCu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(9), G%Domain, G%dxCu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(10), G%Domain, G%dyCv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxT, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyT, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxBu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyBu, scale=L_to_m_scale) + call MOM_write_field(IO_handle, fields(7), G%Domain, G%dxCv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(8), G%Domain, G%dyCu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(9), G%Domain, G%dxCu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(10), G%Domain, G%dyCv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxT, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyT, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxBu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyBu, scale=US%L_to_m) - call MOM_write_field(IO_handle, fields(15), G%Domain, G%areaT, scale=L_to_m_scale**2) - call MOM_write_field(IO_handle, fields(16), G%Domain, G%areaBu, scale=L_to_m_scale**2) + call MOM_write_field(IO_handle, fields(15), G%Domain, G%areaT, scale=US%L_to_m**2) + call MOM_write_field(IO_handle, fields(16), G%Domain, G%areaBu, scale=US%L_to_m**2) - call MOM_write_field(IO_handle, fields(17), G%Domain, G%dx_Cv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(18), G%Domain, G%dy_Cu, scale=L_to_m_scale) + call MOM_write_field(IO_handle, fields(17), G%Domain, G%dx_Cv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(18), G%Domain, G%dy_Cu, scale=US%L_to_m) call MOM_write_field(IO_handle, fields(19), G%Domain, G%mask2dT) if (G%bathymetry_at_vel) then - call MOM_write_field(IO_handle, fields(20), G%Domain, G%Dblock_u, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(21), G%Domain, G%Dopen_u, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(22), G%Domain, G%Dblock_v, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=Z_to_m_scale) + call MOM_write_field(IO_handle, fields(20), G%Domain, G%Dblock_u, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(21), G%Domain, G%Dopen_u, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(22), G%Domain, G%Dblock_v, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=US%Z_to_m) endif call close_file(IO_handle) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index ce1f9ad92f..2aab378b4a 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -742,7 +742,7 @@ end subroutine initialize_thickness_from_file !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_m. +!! layers are contracted to ANGSTROM thickness (which may be 0). !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 23ef41be94..248bf6c0f0 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -40,13 +40,12 @@ module DOME_initialization subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in [m] or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth [m] or [Z ~> m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real :: min_depth ! The minimum and maximum depths [Z ~> m]. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -57,22 +56,20 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" DOME_initialization.F90, DOME_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) do j=js,je ; do i=is,ie if (G%geoLatT(i,j) < 600.0) then if (G%geoLatT(i,j) < 300.0) then D(i,j) = max_depth else - D(i,j) = max_depth - 10.0*m_to_Z * (G%geoLatT(i,j)-300.0) + D(i,j) = max_depth - 10.0*US%m_to_Z * (G%geoLatT(i,j)-300.0) endif else if ((G%geoLonT(i,j) > 1000.0) .AND. (G%geoLonT(i,j) < 1100.0)) then - D(i,j) = 600.0*m_to_Z + D(i,j) = 600.0*US%m_to_Z else D(i,j) = 0.5*min_depth endif diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 617ac0da3d..2ebac05a68 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -42,14 +42,13 @@ module ISOMIP_initialization subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [m ~> Z] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [m ~> Z] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: min_depth ! The minimum and maximum depths [Z ~> m]. - real :: m_to_Z ! A dimensional rescaling factor. ! The following variables are used to set up the bathymetry in the ISOMIP example. real :: bmax ! max depth of bedrock topography [Z ~> m] real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] @@ -70,16 +69,14 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" ISOMIP_initialization.F90, ISOMIP_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) ! The following variables should be transformed into runtime parameters? - bmax = 720.0*m_to_Z ; dc = 500.0*m_to_Z - b0 = -150.0*m_to_Z ; b2 = -728.8*m_to_Z ; b4 = 343.91*m_to_Z ; b6 = -50.57*m_to_Z + bmax = 720.0*US%m_to_Z ; dc = 500.0*US%m_to_Z + b0 = -150.0*US%m_to_Z ; b2 = -728.8*US%m_to_Z ; b4 = 343.91*US%m_to_Z ; b6 = -50.57*US%m_to_Z xbar = 300.0e3 ; fc = 4.0e3 ; wc = 24.0e3 ; ly = 80.0e3 bx = 0.0 ; by = 0.0 ; xtil = 0.0 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 9bdf9b45c3..4c0c55f746 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -119,14 +119,13 @@ end subroutine Kelvin_OBC_end subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [m ~> Z] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D [Z ~> m or m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. - real :: m_to_Z ! A dimensional rescaling factor. real :: min_depth ! The minimum and maximum depths [Z ~> m]. real :: PI ! 3.1415... real :: coast_offset1, coast_offset2, coast_angle, right_angle @@ -134,10 +133,8 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" Kelvin_initialization.F90, Kelvin_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_1", coast_offset1, & default=100.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", coast_offset2, & diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ed7bc07ba3..110a12c5f5 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -325,13 +325,12 @@ end function sech subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [m ~> Z] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real :: PI, Htop, Wtop, Ltop, offset, dist real :: x1, x2, x3, x4, y1, y2 integer :: i,j,is,ie,js,je @@ -340,10 +339,9 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec PI = 4.0*atan(1.0) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & - "The maximum height of the topography.", units="m", scale=m_to_Z, & + "The maximum height of the topography.", units="m", scale=US%m_to_Z, & fail_if_missing=.true.) ! Htop=0.375*max_depth ! max height of topog. above max_depth Wtop = 0.5*G%len_lat ! meridional width of drake and mount diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index b955f75a32..7b46295c20 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -34,17 +34,16 @@ module benchmark_initialization subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths [Z ~> m]. + real :: min_depth ! The minimum depth [Z ~> m] real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! - real :: m_to_Z ! A dimensional rescaling factor. real :: x, y ! This include declares and sets the variable "version". # include "version_variable.h" @@ -55,11 +54,9 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) PI = 4.0*atan(1.0) D0 = max_depth / 0.5 diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 041d77d9f9..2c84a6040c 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -28,8 +28,8 @@ module shelfwave_initialization !> Control structure for shelfwave open boundaries. type, public :: shelfwave_OBC_CS ; private - real :: Lx = 100.0 !< Long-shore length scale of bathymetry. - real :: Ly = 50.0 !< Cross-shore length scale. + real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] + real :: Ly = 50.0 !< Cross-shore length scale [km] real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] real :: jj = 1 !< Cross-shore wave mode. real :: kk !< Parameter. @@ -101,22 +101,19 @@ end subroutine shelfwave_OBC_end subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j real :: y, rLy, Ly, H0 - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & default=50., do_not_log=.true.) call get_param(param_file, mdl,"MINIMUM_DEPTH", H0, & - default=10., units="m", scale=m_to_Z, do_not_log=.true.) + default=10., units="m", scale=US%m_to_Z, do_not_log=.true.) rLy = 0. ; if (Ly>0.) rLy = 1. / Ly diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 18b1fa5225..d59d271471 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -61,10 +61,10 @@ end subroutine USER_set_coord subroutine USER_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_topography: " // & From 763ddab846f8b8caf2221e5c815d68a154d6482e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 Dec 2021 17:48:24 -0500 Subject: [PATCH 090/138] Docs: Add NASA-GMAO to consortium figure This patch updates the PNG file of the consortiums in the docs to include the NASA-GMAO group. --- docs/images/consortium.png | Bin 137969 -> 77829 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/docs/images/consortium.png b/docs/images/consortium.png index b349caf28764c2e79f43a3dacc15dc85959152d1..abe48e5b1dcdc166646e9bb2e3986827b2ef575a 100644 GIT binary patch literal 77829 zcmZ^~Wl&sQ&@GI+ySqEVEs()Nke~sA2M-oxaCetLa0yOucY+6ZcV}>Sy@%(0@2&68 zS5!gO%sIPv%kI5;brYtnB#Vwhf&v8vg)a9|N)-wUmI?|A<`4-1_ymDztK{v^H+fkp zsMoij-))8QP*7A*a#A1EUDJETIZG3U%z>YW!? zXzqmTvCXYkWNd2Sp?>=y(abdIk+kZ;XtJAd8v_f2@+rmSvzd2RT{TSnfY2Be?rw_L z%_>zO76^&@|MwS7MuD&|7L6IP1Vb!b9_2mS53G5w?Mvqljh{+yuepIxLa}JX>7Yk^ zQ70k~w7w`F8EWg!Jq(>rUQ?MF@?|dvxvqX&XIwX5S6-DR07OaY$HLGA_OqJ$SyjR$ z87*C(>jrG%`>TtN<*DOmOlthL&<_3VpWqZKf7O0?_Cc@`(E+1lcc#)vs8nb7Vu>tm zqy*NYIm&XB4v!4l6RlM91}O+o!Tw*KFA{YZGeslGR5P~7bYOy0+OFo;X&ZR34rn6> z;(V2nW_aV8%(H5Ip@|W4Lrk>$c|IG{_p_fN5k0ld-zG6b{^X})_ zpM!-7bK!K)d8dV@(-# zA#!TDU6vIdosNz=+ebY+Uc!j3p=6wLnTw)wA&3pV$?1tPB+Mh~B)0 z${aMquvkO>-V5Ws&w{i7!8gQ5D4ywH9N_t$^Ec&2)yek80+x~<%E(V%D&z(}74u|R z9Dj4&=TC!ILlZrP|1FNCN-qEA7FCHrEb{`Gf@}IrYR26p-saSEuZ;EDP6CByxz@(zB(f&;C$s9^gEM8zFz15AbE(k029 zctJM)dI>)tI*Bt>_jEGP3(nI$m7_-An>D^gy;<*%6KE><#}rgX$>X0wXv*j*K>)7_%_WCDC-iIq896rUHd-SrYBKJHfM3qKMg?R;l@xuy}lm0b7zpT&6NKS}?#%A=zU) z7g5i>r*rIb7ytGxp!&(R^;PqQ)ylnpP#3 zev46lAo@e~Y?u;=b3o*8U(cXY{ZU4;$Q2HMi%T0IEU-%yO4!jChw3yLa}Sj(>imp8 z0Tu!BhXQbztC%t7Y!p@!QxB-HOT4Yf8`nxuMdm3hVjCOQL2 z{ePu0yh&Bm7)Ou6!B>Zb>gKZq6u3#4{;xf0k_eEn(~4vD-h~o}qAp>#`%q#W2b8>= z_AC)9_-Pw&RO?XXHu@}$j&OO9S+7C;A^zd5!}RrLtWUQAZ#Oa|;PJOQzJ(LAR-g3C zh9sAQ#RR?#`i-5HyO2qu;B6mn5|X7f=x9}SXBqQttD(7XN~W=>6}Y=*y{@&N5{Ad) z$9Bd%l0KQ@h3x09Z;WDzdLF%Rh87Tq6+5}~ITb#8(Bs-;9 zA&Jz}ym!G5s;qUij3!%bnQ_z+N)X&mQVmb(OM#}6dI5(`HM<>4D3`@SA($j`Jx zxI<*%JP^x>3SKHy%jByxv+i*J?d9SJqVXZhUJDQOJVHOQC8J5m*=l>XsQ{BI!pkkM z=Q9Ic;fI>h7p8%5p_ih8c9E_S)TbQiN>74D4yU%Ic7urWjiEICX(^uSv-C4^HKe$t zaOg7MMEl?g{yFD!}?5P$XhaNWVG$Baf<_!och0$tuF5%Y80&gXke4f-ma} zv^aW5H{$cpiv`qJJ(L#_auhfx8Csd00%$pf6%wSpv-X3OrG7 zmkEs)!Z@wrfdGO{L*}1D+h-i`Cg zv;F7{KV~Zdev%dk#b?Dw%=cyo?$Hq)Y|5iBiY;dHLF!()-** zq1GOtl=5OByOKCwi>o_Dseqa|as~OBP<%ufy%pr}Jm&b1l9eiWKj!ClP!Hbt70Au; z2X&87vEBEtK7<^oM8UK9?(}W4WyQR#YO0@6w9M=Jm1Mq&5{LC#s23B>&6WLu_M2(B zy?DORKn^hHY;|9qJ)VO{^Ku-wH-KM-xe2+(M#iT7FXC{*J`ZQ{H1$PMSO}xtk-Rtt z_{h!7)^UB0eO1Y!X+5JoTH0T8Sx|W0GO4!{yg5v`!euN7QS-!EXSVnb3T^+9ZD|oR zA3awu<7~E9&Tu`#TC71MWVkahFqlu6W7pk$WurCswb_d>0K&m`b93eP8D0;P9lP}x zt`+5IFg_j?JO96ZVBij;pJMYJ_k``p9xr=tp0ZB+xtMn!1aaBWv1KBl`UFR{cg8Yq zOum14KB)D*2g{&~pX8+POVJ(pR3*xFhtk5l{H>oxmW$LcZHE-lf0XVqg5eaDL3 zeUkZ3NSg>5nYsB(x&qQU;<17r72jrR;|)Ik^LE%& z+VgPfh@7Z2&K37-mBB4qTp#PxsX^LRy5bBPWI;w>e5BtkqI@6d)$;qXz3YL?doI^H zw#+IECbK^c7eFQ(?s`-28%saIueRj0WfEk`qAG6tWzE|D?yIzu^l)^TL(psBdnpJ8 z(8fn-Y#RRSf3*njgk@#NUZ0Ur;Y5&*am92C5xL&(^l$yJ9W}Rl^S*_PylNRcrPixH zu^5tnk;>+qJU;h>m!K{+%yDRbZf{(0gF=z&(M0lUG***E@)b)uz`TY{z^&YaLasl_ zcbp<1QqNqu1N&R+6ArHJk?jntKHbXnb(Zg?`r88k?SmaOMV6?fnL+Eoo`KO!0h3r9 zO(PZQilx}{n9IsJVf((l{(ud_CPtmfJ*Q{N&#osrFnL`i0Y8%x7>f7bEs4lg)-;?_ zBrLm~$~P+6Pyo%iuq=gyZPw-o&8h1d=d3ZpQd|?L=x=(VF~%BspiLYE6Z{^UsaQB3 zD^B7qQM2HYjSNqGnBk_GEv=$HTAnC2M#6^WnB=ut?ysN^eh1*e*dl$UqZ$-Z1pp6JIF_cbjWUYAoKgHO zsybkEV-R7E!`5`EcZz!GfSPd&R91WwZ-rA(7h#`OG>Yx^&l|0vjy$>G?PUc4^y7FM zxiCvRgH?`$q^*+7j84*|dT!rG-ysbMHi-T|U_&Z$#Z9}0x#?D1BZV;*Fd+$=&-U}p z6^_PIIpQD7-60ec(GJ4h)G!|)oSP}@oT)2uODy+6!c)zVMbdanZcD+HZi*6Lx`jud z1}eSU;63x+gtGxVH$S!X{Hx#Yian!!F*8K|^4qnj_|0|oBRwc=n>B=b z03`cYNk~52VQrWVIA4lYZ_c3qqe7@pr8Mn~%7vagNOY{u%E&#{84=5?<|IfE{mpOS z>~&m)7ggiucQbO+K%^IV7aAi{YLZKbGJTl?uUP4~fcgm!%--!P z4JM#ge=GU!V5YtfjGLR{ne^jw6x6}oDS`0-ESYVIIoCg0SyA*w4vc5Yi=Juil}+rB zzAK>yn7iK&kc-8Uz061?2KQw|GebHff68bRLXvIhBQcna<(6A~=%y*USRIycS)5x0 zR%ue@Wz!zUAX@A$u0e`h1I$GY^_GyPq!mJ8x2h)&PAA5 z0q6>$o^eIFx2?G1ey9sY=!<-ue*2K|$R<^`At9CKfAXuhn%Ui_i&;)DUOxnNSx&R062oz*Wk`oU z(E#}WTvpybUFU8SpXl5G*!?Jkv%BHc*Vq8DRGnNllxc4GQgkcFAs+y{ACFlQP~2&B!|L@_d9b23Q8Y@5$eVH=D zZ(-TI?_ZnY3d&m~c-{<-`Q|U5&NkFB;;w+CmdN{$;AF?!=f|^;goI-rl&%tQc{0$f z#r79)186`(wd9~9s`vj;{|-K218pM$XEU^YbF*1sQ+VuB!7k==mSzUz$d$sA7fQbo zUe^Vx+>y01Lv6q!IDVGqtHTYH$Uzo+5K&DC(sJ1NIsq{Qw{6yHl;#Ti(V^XBjE=)g$ zi8!0i{X7=gzrS~(OJ?A!=7CObvt;Fb5{+*t7}+SHXVq$V5eGgF6&S&dzV8m7d4d$~ zxAGWMY-v`|PE;2u3m)HAV5YaldK)u1nnn#iSzSr3W^l)J*N?dMcJWm6_zYp#>=u*- zZ#CNm?)ZYFxGqmmfvO9tH4-vnJ~)?EF%ks;jFV1 z9!h;|6lqQ}$8!TDSgs>%jfh9%{~t*aW-pli{b*S*VTsdX0N)F2>yCq?rU4P2=xjUN z=%(migVTE@?mI!YRw0)UCHj?$gVgBb({Oeu?u-(a*t>O{rpip4p}VwO6Et*Z-KmN& zrq{C)b$GdP1doPc3A_;1S~V>9r$10+TD7C=08QXyboMTO=3@B)Q(9T`st5{g}w8Z1V(!?bRh`qLi}Y1V>NTP+s`3n z94!kuD|O0w3ago3mn=R#TWKzmM~kJomXup=pSRptFK&7OD;kodmhbfXiJkWN{rc^= z`Ahy;hnEJx6Ak9WruWe+N25Z+g{X-a`~LZ&3lE?ZTV2W}un?A0N~>8n^Vn8n-)MZI ztm&XIzdu=K$^#JNZ?5^F<$tIPE82Afel7Uq2-p3j6w&b`n90qpekG;tk!YKj8&5Y&AFjJc&dVng z5YrpOf~{2I+hTw8=zGIk5v-~~)xw*X{>{$UOT_3< zc)pTsmNVqnrLI|wqhMuU7uW5E8*L}4KRH=|!aN?$PjbOn(uYTn3_p;p40Z6Zp41BM z(0chwO$?+!;r01_2#8-V*jq8`NFmc^DIG|{>cbx)#i<&}t!A)kH;@Q($n971_MF_=NNsgl4ptWWmzVDT$IfG9T!DkW`sB< zVAcB@N~EB!W>9bbuc6EJ81eJnS|QJNPkdtJ^WmlHjGJGB)ecGGC_gPyfa=Eed2Yc| z)Q%gU=Se^$(Ryv*WtpmhzX-Mi0DYSw_$7^7EmflLHwXs{2)_;a1(dF}V2%ZRE`bD0Mh}xNz)YwJA-y^7o4h7(ibmTD-%GkBT;{bH0|_YUk7UBneD1-;%?p&mTO+QnOJLqcMe)4l5~jLy>4{ zsX$1--bpY-qhjxTu}IxzTWcCZa)Fk^(9%_|ow zz!&y3{m|Tp}cj#r*$Jj6U#{#^G+4Oz84W}-Kp4+sj zAG;!lK#cHnD=}LqeU3NKEq)pus!#Z0U$*RI7<WA{$PQ)c#G+FIe|Dc-zv>N`nK#1jxj2Np|G)8at@y*S_t$6EM~QH_3Sd5 z%cwZ0JJm*bihtqMxqU*(nIrCM})sMFh8;++?qR+CyTu` zVT>M_U|G4cl+U;gU01Vor9v@%Hzg2fJ_KUjAAHrDLg4&+iBRUb!8@a!(B!cVx0=Rh zr_*mQ58G6Hi4>QW=i5_YvaZ7WOz}z6zUjs&B5_4R(@E|me1U6QE+k8K@4pU|&N*Xc z#2!D)Jfd#Nf4)coHa=agn{u&sb3hiK9B{ez(hn9pbzax|uO{Ladm_#)@8Hsm zO?Du>Z8bgH07cA-&HTdj{dB!Puz_Irl%vx8-Pp+s`V0@NkRzcVF{K};6(D{@ELsGj z^s5%{%=YbyYqmwk0z}#=%}G=FDP0Y~6mMl3j>zW3b%XCl?eVXXK2~;)7W^xu2S(*K z>{fxkoYNA9^RQcEgaTN6^*$Uo8HQ|B?3RMP=9dBSc1psChdIR*7mQaIPyGhCN zCB%h$-JT*O_iN@0WoZQ~VZXpMwzHvP`Wn%$DopAd{Cez6cQ zE0OY+4)A`Va10j9fQ-aM8GbN#>LNRin|Gw#Mo#f%I&pWPOw#u}Q%i-{Z1g?i^(YyB z?ns1`j^_>^Kfdp|NYr>=Vd4Ij>Q2?_^;WxwO`FWPT?9fpkJlpY8B4XZa2-}6Vg(GO zBIB`R_rS!>?^9F#C-()k`f33}%cabtE4~}N zj_`zEE!Fv7|0coMV--IHbaONt5F9jnx>6zhS*uON@%`8f?}($=soA;*uvjRZszlCb zMKnh`bWXmeM|N`da0FBmmp~uPS&2u1GoRwEP{*J4z|MlH0-^emg+}vRFn3CA#LjBQ zQ&&7RAjlB_&A2go+UMR8&=CSeJ~nfnuT+xLa0kDok>C3?etdak2~fr=6Y;Y`^1<^OCa&n%7V^6G z8+SwpY&0a;2!lq5J&p12JLH~{(Rdg4Wy~`7Mxxz93HurQ9_=`K*B~s$8os?|!jmC% zB^#kL9*^w{4ZxRG0i9TLK75m2-!CdCUQD}Vn1O1hCr+a>r%%sfd7y??aZp_?gZ?yQ z?Th)5a(p);>1Hz}HLJ07^^hO31m!x*Z?SPaA7Xt{pPGSh5-cxkTOatigRrn^=B`__ zqh%MeFO#O<6QNDySTm1|)4u-P1n%WY?=wht)|`#-p1VFFKsf+PNX5Nc6BOo(Hdh56 zQlkDimING}h3~k2gQ`pRsI<-wD8XzBvm|(P`41K(``*eIygYXTt1n}focn)g0s2pU zL7}1GwrtDSG9A$+qWPu(4f>kO15w5ucM70h81u?y6fW;8jos3PFICHs5B*3_OEuBK zC0-!aiz0ee zS*3!P+qiQU%=^w)Vg{fAp(=p_bV9kZ%=C&c&&KD;p9Q~fa=GS&gg^#b_TsGG{h(%i zZJI*y$pIzeYQFkMuwmbdQat0jd7o6714r($H zTpwwAY;6*l_LmKQ!bW7Ggj35vthj$r>Eg?Y=xm7k@DySJ#_+zVzNr$XQ{&&0oAnp$ znYZ0-{kPm@T@J4m^u#SJ7NL1AJ)fG~Ggctk;HH ze3qyFFh{Xf6?~w!R5{peXNDd}czsti=SzIYs)$UT6N(q>FWWb+quO3(P2=|Nddc?? z&R3>5H#D9kq8+w5qTOhYpw1qc+Q{MP(~sA>OS0zwM~Q#WSZ!a8r6LU&LJd(wJ+zq} z;Jy?V@~KF$9N20XcFU8LSGd^5dmB%o^{nc_0Uax z#p+Kad8Qw-6+Vvm-qF3b#H)S~=&0Hl_kOKUheaNK!1iy7O`lD*v9jSWcbc!7=)$;v zErPYz`H?Opc;mEA_>}K)yK`wwNP|NUgYJupu4rX=;Qp-J#|&)|T;9_A6IXI)5|wyo za%woT$Mqc!ZvQ6*I=<00cSdeQY%Vm>F=L>a4dq}hQhBMYbW@(*y|9G2tG?1`=QFkD ze2h`H=FuT)y@cRvy5}L0M(B`E+%a}HHe_Susmpi&C|}CEuDIUKm8pr8{T3AeB1@zf zNUCr9445_GkCcU9s-s)f`nB@`fjk<-2b|;U8G2m%^G_Nthv% zhl-Tc@SegTGt0`?A}702SQ}uL5OxjTOKS_Aej|9EOf5Tvu}F;|*80SBD`JSp6=WQ* z5fo~M;JvYj#T6xQ(mL^;@OoK8{&gj<$OlP0BROPw9QopXO{U^V@XMiPN!T z8$`^iABPwOwo7sKKMtb_)aGogTRrD8J;Zzh{?;``^WeM+2}L{Vs1#GY9Jn&FQm@9v zc$_ijqf+Pi>iTPpC;O2vKRF?+oS=`L`-fzE!PM@aJjxZoRCfiDA6l;<2UepDOE@Q7@kfPB)LgHXBQlqS|`mh!O_B zM+ENDeYUdWqW|%Rr3F{hOp2o>}#~U?zXleoCPCJm8KNF_YK;{DdPme9TIz3K=4@(#ko|K zdc0IYE;W(k15n)ic*M58CC%yUv^&!k85s@(^7M9aOTM4Y-otk6mM08a-`W~Pp%wnB z)90wKCdShV@vji%41f*P@Og$+zPg!rs=3-pXJqG2sQuYq+}Hq)*@MMY{u`4J32rWAI}iYz$|$UJrvJy37wd(7M;74?#LZ-Cz%xtc*wK+-Qv2 zUap6Adm%%WhWu`6%@o~n=xX^tqb}dmG&^f44ZF`;iXTfbDTg`vK5#}MyGo|0bMe5PtwTX*sGA03Tgy?dKB$!iwBl5w9FZ$4}c{HYe zs}0k0Xg})9DBQv8Mm<&~VIxs8{^~RcX(rDXk1fbAqxCHJbyJK?sliv_iHzbDp^Y-Q z{8j=~ElzWBRafai;n~pFUf%9u`Reg{FU;G7#!GJYj8w6T91NXRer{*wm}jxf3+28{ znYn4-iXq1zg1LgxO1TP4XtB`2p6s_&89-k&A=uL^pv8N-Ikv)N;cVk4XV6jPN1ZrU zkJM8}o&3mf25tU=QHsSv2i*qS{1Wr~aJDo(j-oYNzpO)pk3~(GT?1UtQxEvhW$4Sr zd28?JyvCuE{G1CSIYe*W#_*W=uVP=8Z|09>8|o)%=0)hk3*K5R5ONBvY9$?PY?0xe z*h&8@`j$BCSimRnMr$H4hG%@6@`S%l<||?l6j34W{3yNhw3O9?Y!)N_B{Te2fYk#; zarMq5sXJs^uMkVS*zd(>ZxKvKXQk^9FV~j_1h2nXQqd2Uy=6k-+qx&5CvR;TbkE@N z4aOhow`VTe;sdc6ScCYm52?+onsc>zCwwIbUZWM#TdKXV#Q_-+(~VG?bLIblW+n0A z?TPvN5q!{EhS2Nkafrjo6yLFYA2_Rz@>o#cREdp}|3$Q7^bTN^LYe4*XgoJiE@7fV zU;Oav^4X1?68+4MN1Q>CAWqb#O>J(y%}N~3B7pl9BL6~6{(zW8C##WPZCCprzD>N#%zBr5*<~Zr3`{dn zZwq2NSbML!-6bh~mwk^3Z7WHTibYdA@U`NpSKOddR^A~i9ogz zYP+W(|1cTs>m11}+XY1bDI=h-E&EpzXW%n_;3WSrda&8z5HWmT?cv>7?3&Dr}y<58G?NSVttIl2sI)#a8Y)$zEGtrKV*xbfKK#}>FGix#CT`Rdz~TA6AAm;1P-ux zQtqG-)?Zo@*%#!aMfc6)CZS4)m#_x-&Fm@hrx;+;slw-#;)x5(`+n8{A9a0V>}jZ6 zskf?|;57l`WG=L=jTQwOGyBj*t+lmJ5tcXAC29nn6@4meZo0aqcRpq#Af&(!5l1_te$n&c$ks35q5K*yJ(AKV2JXPp|dgjCGQG-Xd{fmdqD8} z+19vffDva`rp*hmg~9vyiO#H^<;Gl}M^=}+zQy*THDB8SUY~@#{N2yr$1p=M_sE_v z!@WsOuV`}z2^zS2ywU7fXiG`?@{`|^6 zj9{1a*?3J&&#K-$dH-cC7;IecNmk+2TdmM?O=4x3gpvB^uoqp=UN*f{vI=5XA&J0%_8E%X5RfFe)5ZFp%+GX7_PD&s3QnFTYLL9Y?AZBol;k?W4W=%x+f!#^(Yd0Si&_-rQ>a8FFSt?(4n(_;jY{&u&#<e%59ZrZ4NMf8k%h#gXTUxH~!@|Fet=Q2U3C z5ib@I0l!0wj^HPuY#fqt!WAu0SonzR7GYG&YV5_i3kqQnBEo*_9W5Tm1a!A9hHjy7 zVkikYyPiQD0p;A`lr4GPhNc1a&K74+3c^hFJJ(VTHM3RcGW|jeXLh|QGuRlKq)=4s z86d)cSHVm*UhSeb9-`04(afcvzt9^f!wC+=D*9={b(8r+>NiqDoXU?+2|@N|4w#*f zn4N?bzS%y0Tg(1Olr*DCFlR77JSrAvT9brpr>EYAF<5@+j%}6gJMIgZRd013#co|m zBu*00unZu5{D6zXVRF3bncS=ATc(2$?B=`2Mrp%cN^gQ^H(;gaWb3Ls*tZZaA1I>l z50RDpw4s#j*DGNRuw8y?V!sbB)nNQ|-ZvHJ@>j|uGEBD??X072GWNN+M(9 z*Fh4PGfjb58;tOI>)Kt#_k~rfHfX^7g_Cj90g+Jw^z(SFN^N5`7A&FGbnM)qk-fJL zQSE$=ewwwD*SjAr2Oo1f_P*~eMhf@V3=Owz3D;Of4HjQY1p(CSTht!TULMjxNrGL8 zo9N_2i)a8T_d#tUuwBI_p@oF zh{X{NNSJrKH)f1WO_k(SrDPKIC8#G1M?vvXYpPZW7`jnvziB-HG;4#`X_(sI+QE*M+VXWS z=0T<&%>*#}zM2E3l>%|Lu&jwtBVmE}mJtL)oqUIkuY;>kt-%zBGn(h~e2nyVR^;Z{ z;%9w0D;rGNFTU)_lNvJ7x*dwruPZ@xQhcP? z%K^r%Hjh3+Gbh()9~u*heN5aETMaZ?7vwnmb-)Dq%^b`fCX+;We$~KWj|?nOp9ebI z)QV44ROK2T_=p@PZ3@%;VwFF9wHg0-RU2N&P%?@;g{HT)qI6uFb};jfSCKS00gD=i z4k&1U8DpBvYGtrnsWXO=t^Fm3`HOH<6zz~W+Q%h3Rb=ej*UnqHsSd%0I+r`kQemj$ zROqPuN1J5a`*RaoGE1GCR?P7UeWk3F&P|dEXD{_1DfyB`L%M;^9N#g|`Zs`h!!nlv z%GYbY=BBXh*K>8mFeDzIz?~X)U5MC>%BU*9f3ksf{+-Wr!Ad5!#xVK0x;}`+vs|lk zm4)^9TxrEx?mzTQ2B}8GG`+CM^Akq0r6N@5Pkw4?cIN9Iufz5&odl}Kx1)n%gqUTv zjYuIP@Mkn;BQK_MyRO7B61RJ`^8x`=RkCm&Pj2rP3gF9s6?GtQSTLlI0G-IBNm{dypWEz z<6nzLvuD$hD-FZLAbRMc2v^XvP!%w7f7KP=nHlm*e=}# z`xkawxM?q!xcSAXWBky|QPI3aD}4Aq)Fil^`)&}!{drRw2PXK1R$1yTsMp?Dubpop z50}@Z93=!rqdCFk{+ch?UA%qkcA|GI%Gi4`;zIWHTyRCD9NWzMM7vx#KT9s2h$8T` zwF@QsnGnWes<~j%$D?im%FpOF0b%9u-v^W$8RriqAEWfn3kJ?gD!3vF>C6$Gyy!0e z`C?&z20V2O-OL?9XotMfyY3XrX%K`y)LDNjdNLbuC!GiLgJ&E|3&s<5dgwK_@Cs=> z)BG6sm1zp;Eql*uL1c`)ZPdZVKnerl-ZI?%QK9W~aO?J(A}IT}|>_uSV*Oh#;lA4cGS zrGOtr`~ppS$-F<{1f;y(ashBE_zRI_dL0h_2Law)rSF)laE2KNA2-w0`N3Z5Sr2t( zh&sHJ>LJ+X9JJhiUl+6=3Q?2NLtZbv>fcgQd^`*eIX|r2@KY7`i11;aDZpvp9#Ji? zz3(Y!Z{HAZ^J`zk?S)N*J>7T>apHc_jjQjtp*0x#oX<6UUfVXiSpa#?fCYV=2j{}3Lh{e1B*Fo3j;6agGlnB~dBSQ}9 z-26g~-~Fl&Y3; z$j!Gb_8YORnpbBSKFvy z@|@F)%!RG>I95GTefZORE;4&DEUgDg_THig% z@=^2mx(Q#Mp}CNKES;&P0)c*;*B8J}+QMzDW)iv1JTq=x=DpT;nj(mEFJxnF_^&^U ze=LL>fL=n{J9Wj^gJ~hjG2(sO+UufEkSK&JxZNM_jvt*Atl)O62n*M!U=8gC8l^sTRws_9UBZ$o=VE1$kPLj4Ww6}WvfYvf()dpfr(ZfKhWJ! z8O2J0uE@ni)D$bVi|=g6Yb5UgQzBtg(Dz_u{O_cZWLnr-;jf~2aV1TN6>V#O+U!5b zxhct%pvotWuVr$J3vD+ua47+;$3WoBU!`J{nyzjSEj0hjRgsPIZ>}EVTpDbPHyDVn>wtHgV%DyUwQgaAq)*x`8)6kuiN%IK!&(#Gz`;KBG(T~G>aM90{la%0_ zaG=eNl!X_&CqOo5*?XlT(pdE+mVOFoeu+K0bOHm6tzPXBkehC>-9``c#{E8rlK%VX zhY}nIicA;UhBia&tOU(_DLOf3v^nwbIi$C+ra*f2`DuIb;44BpGsS9}S29X-;g@aI zx}5#XR74-~ciVv|2#J}h>KjV5UWAwqqdg>ugA(0W*;}{QDX}0bko0>{vXB{R<`S8! zl2Ixh!0HdTH?5u1Z(pq0@r^)=)W`CV`P>MUrGAfkQMd5!{ezlO>B$m}C9A}tv|d#P zW5mUL{lz%~6d5AWdOmSeOP6v;aUnn(Jo+v!GqpgrOtv!3Cwo%n}4peGz%215dM)5ShYvE>4on`q4)Cr=J?BCB!zC!P7T>7 z^~nLYY>tVOGNAkJ`tUU*igk8Fc;$TAeBkw-f>DjkM>@BzgX4+jXHOU{4gZUYafmVQ zOiOl}Vv+L)qX$uTX>o#IWze|d4MLSAM47iu2ZAuZg}~4Y2}aX}YWKTsOJb|)pE%mp zUWKAN<-jS*IKHQ0%` zuIe9+^K=|;kFjV%SkRe}6aH~B)BCAP5I-Hh$U~i9xskX(>uAViFXnNspW9MoYNBfu z2rESn@$%YiT@o7L?JZT71DeN~ia4u0j&x>1+*ZzHOMfCN@RzIiIPOe%F?PRzgvcaFlW{ zINRkHR+=Vy57kGbygtoFcG1?C>l3+lTC8X)nE#NIHvA`*E$`62yff*+*G3d2V;rVu3@bvw=1V0VTP?D4+gB8d_kqwX=~IlYMY@$y$dYc+yAhT>jfBoTS5Eq%c)tPXK4jIo zCiUx#$oA#D`iKPQc^D<{N43+z6(Kdgsn+omHV_;wvxJnF6wI@qt%Lws^ogMExdbW| zj$RB%V@NpxRsuOVF{r@QFv@KWsubRN3IA_c(B_ZbAKg$mr!-rgJS4Gi2z6Ph|9>!OTGM+)DB8m$reghjkF6Ez>0mHWBnP5c%^5fb@_zp!}iZi8)LDRrJnf=$-6&8 z56&(vr$WmRfayfsBf6H+;=CC(R-SYj>k_!jjyQ9q6+^8wgu<{}B zHFds*m14yrWM*FlX+kOw3cE{Sv}c2t_($rBP@p&|KLuJhd}I}{&%MK$D1O{#=UQN& z#?MQ2^!%d3sOhF}>V^GK4K)A1vjA_B{fm`;pMDIe{MZtYO1j#haunC%XO?>D5(AY$heU0H{EkQa`(jlosiLBU6G<^iN?d!!dBZTP3boAP7%Fh z;2RJxiJ=wca$vHRHHFy5l-K0`5Er+e@A|2yEy`ugVVCYA6L8}OnO=CRHci8$y5?n} zN1oy(@AzR@u;LbogrMq+WWOo1jxn=8uQ~gQ)i--cr>u@UC5U`Cdm=b84Yk50sq`tl zL8OmcjLU&2&Q`PTvEhi-u%DFjvUd^v>2%qicl%Rx*#1!Hh`z3gpqvW3sK_m0RwQ6n zUSuHd1?_3~-uHBDB)~|K>A2$2x!hKJtqgpGp45_&3JG>?>8UUFHld^v?yJwyT$*KD z`6X@S2CqVGo0-xO_};#(>9=eW%aV7qnOKVSquY;dE`8m~$SAjai{Q>}p@_X1{=_iE zxew=i!fFDx^tr!d?+D@|mE=t1y{RwjPm7)D&0eDQO6TJPj8f4QEykD!kV7bW6ykk` z^@fwD=~Q)Oc<8-ok7;QI8$8TuRyZadF0`syBfLya^J*h^BS)FhDP(4+W%3!C3i52o zj%UCvxk%V}K+tVUHA%{jKW_Vqjbrogd4;E~=qPm^R*A^ftLz5S`J!qLJn^rrjt z%K-rsf)nwlR<5LYC2n@Pp@FSc>;QWavh81q_6rG=B_p4OY8+9r^c*G^1s8b+?~y&;j;QS^jvQ^sf~?A8{{X85+_Ws-W+g>v@3H7nb< zgMVm)d{H_f|A(iq42!D!-kza5q+3Ag?gj}FB&55$yIWFHMY;r(PU#-HOJe8_=>a4p z-!sqe`oG`j%-Lt}mG`~&S~&JoPfz|AcxxsZZ{G&f;wF)+R5#Z8dWF9)dXTc-4EAqK z*!`P0d@TN9MDR!;IW<{l_n%I%a0;LY)7(X`ZM;;v^UKE8GKV=08anz=K#y(; zvgy}1@9p&k4*Er*K}~fI0plNwY8Vw?_ zbz!lr>9fE@Yf=!~VoJZuGEcdaO*#WKh&O@rw*YL`jxm{V6(Q7J+2)Qv`JFQvvaXIf zsOoe*t}90@;&XVRddSLDj@DuT^Ob!>+rwo|p{k(+Ata*n9hgqG@N!ZWffhmDg;FIv zg5y_FVoBHRT6E_TV2eBF$GMbkszJ2rqlP1EwB?r4l1*7)ZI4 zC!^(i*cAETacbV$^vTSy*plOT`pT7ir@BB!#+CyAbXfSq5=FW_V30CJ;p)ttW1IY^ z|KQ?`EVZYrJ|?V&nA{40?wiiM)I$@w*-s|aIOV;&{V(d1{agpcjP;wdpE-<%4fdhc z301)`jJHni@85&p#oDW#)Xt_(M|Vw13i<40d1c*N8;##DHFUXW#5WJcuq1hXa_WyJ zV1z*rJcc-grSw&(?S%c>+g*{j+kRZ^TJ39*Iq$iMG$pFJ<9r(lP>*4F2{<1{hKvZ6 zr+X5u+v;m(6a#3{0#zZIq8%CWA-0b&;xFz#-tD)w5s%k{*=UP;C4TZ|Urm|Q6EQ=dzO`HcR@OuGJMwm- zlX+)UaYM7eHRwuleEA!pev+h@-rT+TF6_{VYr?1{Nu~*Nxd-|zaeX8yF}(CN#>K<| zd%TwC#lGFib2WCn8Y^ajEku53Zo0diu+zJ|mS3BHa(+}vY*3%WYk8f5NqGX+luu{*pH4trO1_?d6~qLJE(BO! z5!!}N1nLrcy!Ohl|^Ou4js)nDU$9DJQOoD4A<--3Q)> zC#vH`3>P-U;2&5TmQr^gEeUPEb9=WO<7!M6Lar0cpOO`l-aTSaP1^&sjWHL)&co%k>c=kv&sMU}SD^J~Mz7)qaj|AfxC`JvBQ&R5J)Z8^~K@+?UlxqnCmDe?4lAj zW8g(Xh`st`E7@U3MB|jaFb@W|DXsq+d~yZv$in+>Q{lyS27@OXoxn4^s;3 zg76>A7XS&Hbqkzi%Rvi4_-i92=EvpS)(LOLsr;140eT z(@d{=k2asJYcoV&rvt?`-NrlEBaYVQ!HlYzuX;eQ_*hyM&7FWle- z<6wz@Ezw;+Z5ZS#|8TpDc;vm;(BNWV2$Fo5)Hk~CC!1oax)VTD2_KXQ@5;rY5jXMx zUyPz|;6zR*n=WFdUzKXj{w@27Y%9|wxx_fBt3&zpBzLui`103lu{(6bOh=Dgv)bK`)P_cvDLOprG6^gC2`t41yo-qB_7o^j)xfx`l zwnW7Kw|+j@G_v;Pw)6XYGq2|}k_k zU-6S_e`N848p^(jj>oy%5Ttf0h{;hGLv;Sl1wO$WpNjB=(ardBT0Vq{mSGmA;J~`Q zj|KV5G)}!d4rsGA=u_p1^V#gnJpp!85?2fNV#bInbx|!&y4H`>S?Zn+QyuuBh$Rm5 z4gni4DiAN;grd)`UYGcxfhUB0%R!yU5@2i4+ET71xpg@`?!e<5|6>4^M;0JLWewE{ zaaj9zVOr1{N+@%NTh3S9=cWQ(hnQ^W>fKrVgS3QET`sU6u6B8+(M_Yw%vRGAt3MiJ z_lExM#3BG^L7J?8`MFdE`JGd1qq7`z9=o#g#7B0MJPsZwv-~G#+PEV%@7B*+1GRFPx0m ztHk_Vq8sX&M&cbgmS;tmMn2?K#kxGYHuuGA7_U5$ORHTJjlBaa+yA0WW4-#1m;s)& zopP_>HmJ*t_g-tX;gq_#<8?>$rE*uLbv>;grn^P?$ zwY_+otrL{>Rr<&wsH#Vn#xT8-tLZ{QrfE;olMEytt+N)=?F2g$HQgI@?LHao3R1?v z@otQ*qP@&!uIY$EM&szHw$Ilw1ks4;T|S}atkod=kc+=+@C#k%-8K7 zu!6{G21~rpvKh@U?0vVPUcoBe0++)-cUJDPqI^M(7XC&Z zgwTQV8g+S`TG%dlk+X&q^J}YCM}ezth-9Z;!*|=EYm-hSR2I=o(EQvdnMipxXQ>Z~`8^9q9M%jt{1eKoFax=O;Le|EXG8Mds!9YgI!y^3U)XDrfaZgYhIEkU2 zU($R$|4G(7+2R0Y5`~Hi!r`e9k)u|OWyhTI;1oh z`Bhc;oVAbub?O6_f%cpIrJoRmw#tz*F6`=_D~t>yzUyqKTk$&)4NaAzjr``5g|p9DOgE+Q z;Onl6Y#=sYG}evK&{A+B8!x32#UoO`%A0n0uLC4{SZOl5-Cr6e$qWEDcSF$#a=ots z_s#O;ha6O~0k$~VV*{i{ON*75Wbq-ejU{;zF+scKokgWGP6S>j?SG=E|3>AK@3fo= zmq;T-X_GE-Q4#&f!{<~ zsD5GNcyjYPjiU3hKcw{0ruBmMwo7z#(_=Fq*9=lR*R+_s*4#h1rsR8WeRS{fyy9D} zL2FA7o+C zNl%-56KQJ+M=%~LMtYZrkkNGGFpV!s+aKRu4OaR0vG6>lBSWtuXl?X+(>=%SIoqsr z8&)%*Ju?3y)XHQ7$2C>r!ywR5V~)iBxwdVe3xn@7q_L}+kU-er$rH~1`G%uQ8~ z^juAKtK4-j6X>3JSA(k%%uB=;aJ-{~akFX}@A@Mw7@LY*s2Q(Wfm4NdfPTE&=&P`<}VueB0|Z-ozFoJd@qppKZTLFHcDx9J()9kl&Tpe0ZTRdvVpOEEX_OVt=3A=*NoMZai@? z|LF|sQhK3#wn8;ZbB&yvuif4q=v{8(Fp6E&@=tCJeOfXlq74b2VBvd8 z$6j2nI3W-*h{J15%+%0Rx9ymR)Oy(*3X(hf4`fPy{f(*8@;!JtV5D+Fca!~a?djw4 z=7WLRc%Vbj*8;;MmUn63d5i;lY@3hOzIf6{Zh;4``jXpU2>b7h>J{pLHHzEkH^h`2 zPTH}_`E9tS7C?ogR1u4)+E?QnnAYbY+)so26neUGxWOnD6_W&-OhcTkF4vX7&G6J2 z5wQyWb1)ZQt$1~=cxpD{oN6K*g^ISGuvk2GjH2`++KH=A$o@_Hr4fH_-Gr0fFi{@* zZ@>A=Tr4iAxQxf|n0ah$VdA(l!zJEyGd+N~qi@@4si+c=1>5<(9c@1V%L(iX z#$=a~X>LoD!z4oPYfBY zKE-@tMJTD2)bCU_<3+z8gE$;|x$^M3VFFB+J(YNFqz+COyC&2=9yYtkmJ@rvSC3*G z;4P35>rLJwOUd@#DO=O}Q6Fn9b>A51HOo~&Bj}iKI0GP_`}W8~xsR`pt6>19(i-W0@`SEV=k%>ESKAnd2qWv$*ojhXDP zhdcy565s~J71?SRZqY7nX2r00u1z;&?wwUUbR$%oy4Ip+Gm0jFg0(`BoL_wD7$-8g_s z_vISd`wPD)phNc%*6S3dsCL#Qi{gKkPX#1N2e1&Rx7;f{M|P%JvDVJvQ%Y&1@K#h0 z4BA913gHZuu~6|%mg5h>plg!mF9<)l9r=|shARfkw!&C|$N~U~&#zlW8?8^kQjISTiW?$t@)D(lBMyMcpEJJv0CxZ5J>Lyy{gm9mLw-x4qZI)*5!(PHgK=>Q z#n_U8Roi8&&))duWQm6f$<=YsjK>XJh(ApaI_CvkZghGkIQ0j0jhQKXbI?@k>+GJp zrX?FhU+?Fu_1YTA46=o!HVWcK7ij(|$}oe|PhoIzW~%mKK1%DOCzzHCsx&$7H&DCz zQY7TuYFDM(%6jAo2^vdy>;qJaTjcdY`Z9KGQu#&p`v4z6fO8xdb);$sWdL03?Q6#0 z!i`!f`>O(;AZnv(_w@!u|3W4VdJ)Z&R}%RS@=J1Wr&!qPmyVJYl+FLK>m&ncAOHaj zvq(sl%)EilbH^*Gyjmejk0xTh-q~<1v1?^uM2@h<7^xKm+Vb|UMl|_;$&1aNyEDRY z<8wh)vNikeSB)&uD5}ECk8ZRkh4oo?;n=XK|0FRbg2W950`-Khg@4lcSX_{0!$o_T|*}YAiE@ zkCo-73?AyDHgoKK;`b&B$uvS%YWgjFa5kTi|-8pwI{%1XeLt)rEGa- z1%4+gbPsw5!MaVl{ai)MRIkyL)*HI|I;>2>0A@1p-maHeHL~c@)CUJ3Ac5n%9pD>z zpYvlF&s;5fm$#b_WW5AD!{%OQKU_clYc{sT2%uF&V`En#oZdiVuXKPTh;XsoaCfm@ z69m5d$#D&ef&*1I&0AIb7;4=!TMcze9sOFM4H&R^4XqnQ%>T9#Ab8MB&iy6K=8KK7 zGBD`uH<+W5*C}kN?K+laJ$r8hfnA&szkh$6NcS*n<1in9-J6c^E}un~;4ARt`oHYQ zd&7#9)3O4TxMFF!3`BqxWO`$nDWj&?rPs9xP{X)REMoO#u($xoAR@&5_uuT5Ln!H=`w z>laR6_2d!mKnn5*`OdPu<1ul3Mn@afb1(_46D})n0a@8J zh=f1`?`g;`XxXB0*1JySplgUD$B6{-Vy))`^5wr9UL>`%NA8YWm3yW2)`AvH;miGx zSI^Avk{z%oDc@Vjk-ZK7w=V5mMBqCPY|rtDyE1ewx%?%-$Z0PV_Tm|6m5F4gNPTX$_M_uvBPkTXqr%XKs6ay9pn6Z=^ zzb*L;xkgwdAX%e2N5;LrFYJIW(v<)bU2q;4KAJKhnlxhdWNMKKo9`u8fx18p+qPqR z1qzvHBqajEpyi|e!=?aPDaTNhf!Y2aL!SdE2p=^;^}Y++-EjBFBA@}vb`yjPHM3!R z9qXq|1uVeD%LP5nF(9#CqLSmw|J&i$UT0o;z#ShQh5_(^_{Z?KyD1NDW>1VZ`A`33 z*8Wh!6#o1)7grXH#?~a7SYn;!oXIIBk#iTX@qe`d0r{yK>OkehwCs~eP~x8EH!lb( z@M>u|Kes*85U|i8w^=L*D0*fO38$1m-pr z@jxTGOsQ>i`C!dmIZ9qYC+R_CeTf?e@N zL&6jt*F97d|55%krB&J1Y4lASI0vLW(wr81K_%vu5k*^An~6M*`P}?F&aMbib&*P* zZ{b-pC66=jBDv{%#mXsLkNj!2$mkF=GyD0Uy*xlXBT7`@yQ0n9y01RZ{!ulrK{O5) zDR?S4tXrAy#{i}VWGrgN^YSj}r`5g7y<3szJ9`uf!<31A2SFxayI%}7iYDO|h>(4J zEju&X!xyK^zt85M^8;^v_*87m_wgF};Y@;SToUYY3~cc-xR+1Iafr3KRW8PWESJ#5 zhuSS$+v;SuU@~ONYbFr?HV?i@{D8`!1+cx*YOC95bI$f|2_H)J-p9voV8^BwGZ^GE z?&Zs?6HOE{TMoU@GvFOeR8r7X*MGa5BhU8%fa#071p5uPt~mIVF7++PacLh?&3!<$ zA9aOPZroppce1)jxM2jEiC%_|F+KsmT3fpz8~o*vhK*^p5>P zfEdTwHCYpgr7ZId5Ew;VT@j5ShVtUH*PD%>UjOfWZ zrlH|Cm&T!lG~=I2Gxmsn8avHp&;%Zgi+`~8p;p5!LJxTgj;giQNrhUFZUf~;XkG9G zo}342u;MYpw1CH?DYJk^{yo8Z>3b|Z^M-E~!g{9aENy>C@+kYBsxo+V zU7P>00kfVYz9Lut?!ISHcV z5|sj9hGQ?^z6~LvaYkxRarSy)ogw-;feX7yZ>8iopYpBf%QzNvd{g+cx+)NObnowx z0Y6uRj^RE(ClQ6ixn|3AzK0m$>zz|v@t0vVz%e)` z+hy*JjrDAe?mMj?2zAMm@XsF9i)u`9EBgjsBT(mDwV|(IKJ=afRrTBS#oCcD6PrSj zPIE}9O77hf^HBs}eu0?pA4;Iwd}OM@Bh=4Z{zY(p(t9nNqWbvQfB!NSs&-N@avfQS zGAESRpUqVimTgIk{0LyVtHAA%K{)O6uxv^>VfV^AVeg+E$C7uAsOn`}3;2}g%xXQC zl5dg>;@?J(-t~1udyb4>GE2Fkbb@|#?CMWRmp7W&YPGA@d;;Os%S84~L?^DyM_ zM@CXNBbS_ntO_eWsZLa*?h0V>RYF{1eJ(pcb{O}PBC`Dw1#a%ZX^e4$vURlbT+&FX0cx`(q+A0#n@QPy1Isy#Fe|6< z;WRr(Lo?GqO$cXzL?L~<%r3iA7}TDo1?qhg%T*02+AfjWdoD1X@6C$N=USC90IYiu zw7Lh3te}A#dI&FJ^pS^jFM;2NI0-#xy{PKO-7ccqse*i|L(FYe+8<3L_nJ%3v5n0i{PP5E4xQSC*uOAm; zW;S*rz<2hk3RTlI?(UF$wtli&a#75vdaNMZBa_NpZHd53kWraN!(RZZ`GQe>-cdF^ zjt(=E=%PYbQI>N?CGCuFuO(sE^dd!_*wy>0kTdVW7vqX1X=R-@($7FGmDaQO$cG-o zU)JxG+grn+TazS_NDL#{bR~pKa^fYnie`?Y;kNeNS?uGTJNk zaSO8f05-bE{A}jKhEKR8s(Gc?%T-04xnTSZU}_UU66(NiH!99FMI#35W(v^8xjl3q>Tnc_5^BpWI0T%GPUGgfzwlf>z07=m7 zOcK|9yvUO@7e(blPrHB9p8NEdvdV3fO69E)(&oSUo}~qDqlJ>j`g3hs%>KWnuu=mQR)U^n2 zewG= zbxg-`@um5A!~UT&%EAYp()fS?Br^pU;q1!+KnB= z-V|Z*Nr^xji4@3m&?tLr7;N8~VRwt@b4)dc-BThNe&pR@sgL#5ufO1N{FrREO>~#| zu~C7MbP@GeV^3L2jbm%~SAgH_=P;yQKGzP!3Jhb@X2?uafxLDu_D_-L^^X$CxjUc| zb=8I@CQdVd@=Qpm?Z|OaQD6p2akwo;af+PBU^|pdUTu{2xjKRph(#bwy9HROPiT2* zuzEk{j;Yb2(OKNFG}<$~U@Xjx4#up#sWx-)fgnB6s}bgVg*?%7AcATni9X}{yDTRf zY+>k0Q#MtL3)B&^Q|NE=K{~~2*s&WcqORU!Yfnxyk9g#lQELvK*{z$)*g|=M=YFvgmgEZ92&-h1mHo}9FHrpy2uk9sj3(T;4MQCnMgl;$^V7&0;_4yPv zSNt}}>1+{WLvBNjro&o@3yJj8jPQ$Z-L`9_AUXqog+Gp8r}~xeHEokY)0MQX*s_Dt zx;x$CvSEiHqwrtmN1eaTnMT5U3>Ug^uTLW?oEX{!0~V9>T}`{ZP-e-#MwfERLHEFz zH8{>AL4WJe@nf9WSapD!lAki3gtePyK*{TG z073jSg$L>};#k2UB4A=^+6znb?>J^kMuWbT4B=q9y#5X(JN;3!l6oBHQcXt?ShcuISor zivz!jk608qztiK$%TrcWk@{0+3LcXFODsqi%8@HcWNTj=PxnWeCucZ-kXv#@<6Yrn z|Lx9{oK{f#rrFdxJ;yaJJI+<0G~+n6gI`=mEJ|cmZB3fRKQjhuH0xlT2{n>XHDShJ z+F8h>Wzf!AYa-{4!z)1lFZ9v~D-YGFVJM&HQvz4iZX0B=%&HN-yxut3c#T(3`|C(E zmzjNlh2sYVui#t`(FrFQ`KZIsHdn5@yZWbQC*u`^vd$b%1px>DbWPQTMB-clbVf5D zK7z;;is3N*hUy5n#;@-LpyB_5rwXHRBK&~o>)1c^g@Bl^Q~)dy*`O+8kF`c~5H9kvw}ami4=goBRI8YmrZ?S= zbRZ3)s!ITk0B-k(nS}9%kqH1faLfQ+lGoMtyVcsL^tD9Kt``N1wucBm=v@mBJ)efB z>b+}M)!T>ZQCqg6uNkUTbtq2@N#0aS&TtJGbR~$7&I}ngD~=l1PUM%^e=y7;wg`Q@sq92Gr8iK1{DdE_FMe1eddcX#CV}w^~ZbHV~*cRrV?g36y2_!8dx!eeI)AcgKKJ0qEv4UN{-L;)u zMY1O%TZ>k4D(rvbNmJ&LR!FwHAmIM@hsW-$+I0yMkhfWNz?6Xx7DO*OHmK#a^5Siw zOWa$W(B@=$+&5|`Mnx|J=1_>c9=@bzb;|J*?RJq4Sm-)EMZk2b&9K`J6?e^pflqd% z)RigqG4mRHA&pcs0JJJC;n;^tLBj-%cmDW{`!Vu0_3kSrCrFN&O^?#p>g&mc)`(yFMZ`?A0HKRo-O>Pu3r?|Eb>|g$(Z7>?s}MUS4yG=WFyPV?l{}( zVyus7zrThx1NWBzk?M%?+SL_7#lU}gXrSd9N2o$J;p7OZ{+qdj5)$qGG_*D6l6G`{1L#HMR^T83mW?P)!VLm_;BPO_N zAG%f`{3rx0BF@w0YYw>-i_LEsMBF;^sacH(`5CTZKuFWyvHE-Wa%v=7w z51oLE=xjk1f~;1~#8GQbNG2=k{6k5#^L~QccZy=f697X*m?sFOup?szlFv;oQ%qO| z{Dk<+%YO-t10KPMA>Q#9SJ+FdF}&=2S_apQRXtg$L#&lVex;Xi0YaOmwA1Z1;6xZ$ z1cX8@ycOf~dyBT8{su*_`1I1HHeB2O2%Wx)?%n;$L9ylgKvP5JQ1AmVb_3_E+TlrQ z;No$;2t4`H29Vn7#5r>zDyqx+s>rLH6_aUxC(!)iob)VI$W%h%?%&!lV-#ZcN~yxsyMY-MK_aK&&|z<(QsjGLfE=$V0lf4m01e__+flz%?LlQx2;q?R|Lbc$X?c+H0M zSBQ;3R!FYu#h>o_(_H=CTFJGi%#uDKkvy;1tEDJ~d77i4^{<~c=WOS=zeJb?spTZH zOwNcKdvoY2Y$mc9ZsxzjI+7Ws=Q&%?>D|lQn?8BaU>;|E>Ci7?F5>gjPB!F&N}$#a z5LS?8uDytPvs4;yY`khd^(*1)}~(1 zn?>XjtRQQs)PP{QE4u!fs~$IJQUqCMCL=HS<2jR&G*ML|!zZK)NsRVIQ< zS7(U@Ogj~e?|@y>d%7cu_dg~c!HmoBhVp*fC7Fi*hO4i`K8^(blr zRiHo~zRTW^tuw(NRF|$#kCV%3KxW)((VZz1!&P-Vch;7(LF5*bt?{~49pL%*H zuU0(x*NrdnSl1sL6~QmaNJb-|)Rh7eN3y~)G9NVO_^=BjRejhp<34QoZP1&3f~$u# z1jv0V6b|x0i-4u2^PSTSl|^WFVv^dr^S0>qsmt(Rwgi+DkQl{i4V0<#czoH{ec;a> z?uZ~DT+lrqNYl!tc|kP1){wQ>#kvm*Vz!97ZNC-jBiowqu-a7{TvJENzYm>%w`@ck z0b`s5K|!iuc;FTDT}uP}0z6OlRAhQMuzA*&BN$bXv-l%Ogs8Ip<{{aUpjKR|__SipkS984Fhf62pu?^a8Awie);*TC-OzQvcM10Eqi zL6-gQPdwD$I?EY>*V7e<@IdAuefQ2XF&9s{stDl+sT3>w&1zgkD|kr1CD%AD*X#D_ zFK3a?qVsB6*Y^OvJ3~K#Qj6#>BHpAROcURv`pIIqmrbFK9inv(=k|2VO-1*}7Ug0g zGpZiUYjtTg=_MlwKkyHBsZmiwOr$CKD4SoT_jQ{a1AL$fckR*zN3T6GPe1&V^Yk(C zR7=lPjt4!JyUB=q<}>2bjrCQ4NW>j#RU_zx`Nb_o`9~~Io!rEe8fe#vNZ)yvU-@a6iSG9`pKaV`0KS zgp6~2vI5n_Y%;@O(7E=(hvujl*I{qE^zBrreF}Z^rRnagU64 zUu#PqHg3s%V9)SXRQ%+)o{GbGGq_sdUgh)f-PrJHJ7l57l}Ii_Pe?{4=H#o={Tp#y zml?WR_HgIUbOCYEJ6LgvX1brR^ZDLeKQO*6U08^@vb~`b+-u_vriSy|oN)uHm+_zC z%{H^-_3rAgJod~)ip^z!yQdK~SaZkH(WmdVxFt zp@OwW#GHzq(3Rhgj`pLJleoRke&r;DFJ7OTc+o+?4?D>x18_pg>Y-4eEc8+w$LLKU z{z5Q}8(4SPu7N3ow!s>GQXB*L=!;*F^sS*2@(`tqU5m&1z=?9kYg5}@qMe^MLZSb$ z$}D6tJ^GsuK^4dq&WIdHPYAcp=kN*7$_K{ZIp>Fe215cj-d9XMJ_+o-D9{7^u7XC+ z#KY?7Z@3Q~y0du9CvNuuLW#^-Pz9~eNVkE>Mwb-IXXC+3cr4Q7rAsjV9649ubK8B- z563O`?OCOiuq@^$BFinQ-(h=m>V+SAJAtn$JuIfP{|=IK1`g$OxKq{W3rmFY8|wn@ zb;A`bXu+;X8tLV@BeqqWFR%;bu4SdzoS-PPzy=$?yB~-Fm!E7YX1--SWd3_TUiAu0 z@p>LShich?Ehq}x2_wk;i$=oh4!Z zXsqp?sPY)t|L1$$z0k51M7(d9cVv(_S~jimQDy33;*1Sn5j?WZ@4!fP`6cE?x*CKY zicKlhu8LAavfy!RAzHHugJNiS{Gy5X-Eo)%A;Pp59)H$I10&vroc1>xETMG!S--Gh zRcRQPMULq0Sq4NxPeB($nMnQTYXLYL9VSbZ&k`-DF8Z77p;&*2%oqm|kVx~(4)gg# zlv&rBO{%3a2~QixjFsLVK7n2$zdP0Z&S5P0lOeW~tMDK<%iYIH#C+bJkrk3sJqm!-SjbG0ESWc{V4vgi-{CF{Xo#G;9HKszk9 za!t9C|EmQ+5{UdG-0*5&kO>xB{L9yc5DfVFH8atWqbsM8^CD#=YM{Vp%HLLo= zpZWI8CB`Ttj8f*c8kFZq84Sk?;a6>@t17x(6xvSVen-QKi&17vC7FsvWjxUO^cca7 zV2rhZbi7Eq8w8{Yu=UM@?@J;BewKJKvy-Vr@xYK_@kEQoCd9n^97e2fD0fVm^BQ57 zRLhA8?8&4RQ|)1DjS9ci8{McB=PTmvcjl+GT|Y+iEYz7(Et6DQ-uDn)Uq`Z1UVezm zKfF^J{PlKY_24dfCg2NT1v3YZ(|uVFjY9>k3W11xXc~nSyYEZT!h;G_YiA{A>&{T=dUM@3Cpp%AyKN^*?Y`O=uz<?^`lOz*bmZVuvdw5U()=fkyN2_|y!@o>2e1Z^V zR+%^~d&`ectzzu+{ZNeF)8D;TW>%{O%Fds5ML62hs;y@JB3I;zO|EnVR#ufL7HwUW zZwpBxgnYg!^`PlCICHLiW9rU!Y`61U9=FkzJDI*6ZvfQp%dBP`~#6-?*c+94^e--gTos7WKBGy;O_Tl{l0_l;(Vg)r?Y zWn2YYz~n~0#y>j^5mh-&^a905_CFDYKB;zN0{BL?n0$ zt7h1K5+M;4k16YsUEU>VN2ah^iDAO?W0so23VN&FLC$_3c>Xo(vTM?y%kG`(>r|I#sBr zQ-RZB^`=*yd)=ZH(Ha}`AUTp)=ol9eKFG;|s^h#QRXX36VL47%=UoF$w;E-tBXp0! zMqDVKQ6jrC*?fIG%C}Ymfg;onhZvqR7VoF_oZ8PO-*jDm8cK!Q7knvT!W0$vDb_F6 z+5fPI{=V%=ueTa1xx3Z+czzl|;&l!QDytF)^+8)p3V*{gPwh*04ukhuT&uQg>;~wF zajEQFa_TfSuq`4jGOIVR1?q8Kh{JEp%QuM_Ib1nmUpVt4@uVY`9wBYfl9KL~p6FZ` z>D5;_f5ZstZKvBsx(7KJT0-P4h`z|@9K_mT)bRh!i&9Jd~uzMlO-1MrZn@qnb@jNpuH%1 zZ6lMqkKy%gPWgvpy_Q_L^?29$_>9B?<|E3PV3g`-2TW4|n{alx zb;Y6g?RuPc(V0IFIE~%^Wwg18ZVOkN~OF^+j1rV7N>oM{Gg7({mrF z;fZKJ`qc-aMS&3ELg$cfH>!QccJPoSqK{fV%VSkpe#pj>ihHkvKhrphVNtd+yJ5>> zn>R1-I)%MUW}_71^(MPM|I9u>?bBlDpqgTRs8DtSdM8=bmmT>0fPGFycS(xUkvBy& zs8c#cjJnTxAJO%og49GkB{*rglCLNP{eZ%2m)413DP zHHu1jtsG@q&?~P`#7`k)5NkKaf)&~CV=pGvW@~YBqzR%0uajYs7U|=sg7Wi@OsT!% zQf$}LnG_07_A=)v`t7TLkU%U@!dl!Y^l0KLJ3>LX5lIsKW;pOhy(2fMVvunyU!INk zxU-s^vNyFfk1jf$uwdV5cZNBe^sd%05C8YQ*JU`a@|lXVkrZ}+HOV>T;A)Ql8@52g za`2&+01K*cpVs~Q=T_u!nos`4<^dG2_Ue`G-Ig+ViyS&ZqT1BMe1`!UzTU(9Vv||k zM)R>~tG|k-IFM}YHOeZxcX+?AWwq@$(;bEL#lD{oO!N+dN^KNk{FX`ehNyNphMhRj zMtG;x&1%1m$}iC=%bVMj2kAuJU6Hy@XZYA*DWyy$^h~5g9kd z)ow?@;@wI-gsJ9>`@)yL$Umo5way5$VYJ5=~;J1~orRHdr;e5f$3Ajv`2=Z(T`?Paf zg$^uCOT@q>H2~(?62Hi$s-nZ1)lDn}wO7CCt&s705{Gh>O_m$$p;_^FcaMR*d$d?L z_*+f-NC=)NPCply%l<4;sdva^)#Z?$Ez=z+5V?;lR|{~E{T=VTX)>#t)pEesjSgr3 zB!*_s6EVltKCNglVg(C}TdeyFz_Yd1$$3M(vg5ZyAcWe`$AH}rV+HT*e6}`tX3|^PksR^5OZL=~t7O9+MKN^FWbO42&1Nr1~ zvd`75eDiZDKfz-TUDIm5<)ia@MV@yo@I`&|SwrpM4C^8ezok&phCWUWaxhk;vbC&_ z8J8S!Tv`^bvz_q2br#`Vy}`E*;Y7bFvmZLHUGO%orlu|k4%OZO;W<-wcWRY73E{#aqAqm zIP5(c2AwpN>5OhORUitOQt1RRYGxmfi>B8F51-h~FrNq}(rIU>=(CJEFYEb!HHW!o zwj73tNFQr;^vV{hDxMm}+-0X1jXd5+(F$=6th5>G6d&-pHb$MlsbuUaSV8wfCO~}x z)%K?99L)D({suTu7dK?-A@hs_4oR?g(R4|~-0f|P3ix*u=+UsJPvN}l>TkX|reV!h z!KEXG>$^%ATpO6(1V*ZfBu!zz6y?nRLXA0~tE`fKm}CJ*Su(nv?;(`>^{Y)1>-3S7 z(WG{H7JK9T`QQenmVB4xZ_Q?4!8!@d*VKYV2Ygn^HF0r@znAKKWL^DqqKrF`yrM*Y zoWnK<-{$#w`r4j0TZ|%+Qan8%O!z)TOE#%1#;spgv?^FX&&y(jJAKDO1@blTjss)M z@ge7;DB}j?xjR6~N>j=9=fB=MoRRMJ z=H5tNvYnAteE3z65=a~5`Gn;QRc~rLA>_pl0>$7xSNk#n_%ZjYH@$Xjd?j1@6j#^Z zd_S`F2-y;z^0Nh-n40Xrookxx)_vdt_PN7+4gPiu)Yjb#GC1jC(}t4apOvk;OYGe` z*J)z!m5_e+>90;fkTx70GPyOmL<*Z_#M3K7LI)4w>u^whWU!kWi!%P*1V^~%wK4)O zEQhel_@fA=k>z1k%P8v-3yAvWi&40*E#D)HY_=1wuH~1nQAAWy^KJ)WtuY~+X}M;9 zw^E2}F`e8`b-}UpLS0Hb?Ew!i!=mSF2^3`H(>6ho=m10Bg=f7dBf}tfPBLz!!g%CL z9{an$J)l8qlaHm%chY+oH=7V!trT7KLsp5&Yik|oR~M$1o>){uu>Iv8-7p=|X3~Cg zaXR4)`S8A`vOTJ3+BIALz=g zMt8O`Ugg1R@f%<&F@c zF_;oB{#z+fCQN#p%`hi!v?d`9b)?6#7qF`;+L4+whxDTs&bHLE zr1j)L;;pqqX1K|gL8j6O|l) zai+~9nN-x@eMMAiv}!GK?MI>lQEe~_yCK+`RN|4RdtcAD@O<=DEH3|9zR>o=sl@Yc zh$8(r9RhgoyC}UMb2uk zH9z3kT9wk#Y>Dx-&Va^Hn?dP*uUq{k#1-p_7?rCp;zc@)UW5;pSSVI{_6h{+J;!a% z*GHlP3!c+84@u;w+Y1((9l*u$iivDdD7xwUTSk8(=2((<5iiXV(OFwg`#ilcTm7I) z)r5uEDi$->G-VDg`NDnp$n^CpG{xDBTDvSq;lpV9A*;#2VJ!xp13$GNctxT%50B2~ zh=H>mKi10kD-JoZ`PzG%;vtKBNCmUv+t!zMhUe3AHrO|3MZAMc&?sp8BGJ&vtjNIruQ_JGbjjTlA@TY=ePfA4TShvu>) zbNnI?qNJ`?1Rg*(J!~usl*7;(SK&alVqCxSDr=9I?SyY>*IWs3FRQxH?ft>JzZ4Oc|NZ@O@7&~-ZVS;A%(qw)K^AGuxI=a;v z^CkLLG`Cl8VRL=HYBaX7pomXHtqP&N%fwdyFcsUh>z}8;^H;M#h!G1#J9Y75x-R#` zd0UmVswh$T@e#k3J)CPeAEj~_E)?_!djhPymtX9}X^n@tVaRq6*Ud~8O+@^Yi0Ys$ z`QC#kd#+Bvrl)&po~*F>Y2>5%OM7ygYe9Lm zcu+ak-V$DIAr(I4uL@3{7O0k|u9ZIgTjIcdrwdgep_aiM>FX8(&nbtc$TuFMyO~+N zK7R0%xk5%RCEvh;v+(@#kGo?fxv48oMgKZL>f9eO2cT660{OG#8e{;DTjwO`n=Fkh<7wC(=TcI?f3y6Po)t0kmNrVT{{)^3GM%To3gEDJ{RR+CUS- zixcZQgk(OXT7f%0Heqxavg9wQJO)Td z%WM89AayF4gN#f@e~PB{mI6xN*=L{PCowj#FIMkwx@I6v=|bIBs`)E4xJUX~`u3)$ z4wMKjl4&1!a8_RXar=OpvpL6V-LR90hR%m-GuI2MbBgsE+B-58>lG0Lm z%wQh1{?P1LU`*-@Bk)vsngsNwSQ3k&V-o1g7*9A7A>L$rrW^+wscl>B7qFc2?ToW~ zfwgt9w>RTovLBPAsx0$F(Mx-zT%|7>T*a-`P*rUUhVnly>*RyXv-v8xG=s^& zKLlv$Gn(64?f`$@R+?bN9Duulw2uJ;Um%+J5p$|dh3-!$T)uCYHi)t%2K%Jrx9Qtl z^bnoqp}!8N+WZgHaYf_VdJ_Yy3dCIgz@N`|Z={>t%4fJ$L9V#|l*+(NCURgbEqOt< zgDnQQpr$1~De*-sm*i^Pkp&O`SibeoP`4Z~^N0=B17Hr#p*!i?ew{EXDf*{OSwRW< zIz=ar2y9zT!wMqJ=-{6d$ZQ12EBhg555|QMDTuhKL#y4RLAv!X>uC!ec=h>rflsHb z;ORnGK?wjNQw+o{h=tZ@i|&?}XlBPnR<`uh)Y`x?KK&jNHSMVRo=bHyrUlIw(t1OY z_;7t_d~)SX2hnm{UX=sNe66ns&ntzQ^s4@R9HZ`%ae$ZeC4h-y+>?V|nbzEWipU2w z4>?Eh>9&PWRHNh>e7XGCE9sJd>W#1c&z~H zbFTArc}W+$$nrsqwq4p?dalSMr&#Si9Z)HGIXM^cjYK&=Mp1Vuc3izKZg5epUDd!Y z$t{U&eA1qI*4}oFn{d0dXlw_WF{~opQYx_`hdz(l`^58qhM+0ec{;JFNH$@h zO%L7yr&}!&3RD+LDSkX1cBnmzLZ0~g4Y|o#7?0Bvw36elpdpJv^1@YBajiy6F%{g6 zw)cS2vt{Z-FZ$r>Ughw$Q|Z#;CS5$Rh;+BEx9W&5D`FL(_`6WC{AugTt&Ut@;+6yS z!NH<>aX9=4i=mY`PuX@p;I$u3dwy+pXY{q9*BI(_<+9*pDdLGKku4yhOVgsT_mv$4a^CVL6&qxriSenja3(K857Vw2MK&XC^<1}`?KJ(r=-V{YQ z+@;>BO+YdJom(+)O8FU+!kG%}8{)=Wuv$x;t!_ssjv^lNr&(@k-oou18cPIB>M`1* zl6V?*o)!3O8a$^$%!F=!f~V5h>)y`>ORH@$aL8=P2P z=b=wtOtcgEujB!^`e5ImzD90_YkVvZ_%uUvS578$D;J(PX49CwLG`2L9mj5DP zO!Vvml10VW77N(yqb0W#;u08=emk=m*FQM291on2Ch;N&=SaG>4B7W!*vv!vqBgLv zh#UBl(<$-AYC1qMYf)TI82>kns{k1xNt+GqJGuI^iI7C-l;LcI8T81=c_%a+=o{HRg?n+0+XPAsm1#)dtTcXPyp}T! z6)6~Hn3e>?SYU~aG5+0rwj6aDy?(%m%13(wF=CrEM@L*ks&7(b-|0;S$&D{3AMs4D-u=p3jovBNTiKpZ zpoH3M2)dxqzy0v5+2bvM%!SEHXDPw*xms?O92ka5OW%l(w-9oE3^>>Ij3M1^_-LN$ zp7}J=+9{IRT9fmNj!4`q{%q#&q+c-fLR9hX`A6n*F%t4=24o3P@_#o&1$**hRp#y0 z+f_0U4)*AeR2wY)L*;R;WP3tAWjgXAc)| zRTtbsc`7+&i$VBeZpGy(7)Qq3K~~PCn9aeK3r>jbBB!SVtr!tr;EO#v#$pNk4#%|E z__wr`##g_DY%`ml-{ivGlkMf(0dqAbe=R3rfAv>bRS02s|LM0?sf9KNo%;K7GG0v1 zk09Ue?!Fz?!UH^+Z>CTY%cRpQwGl5k0i4d@(9SO(A^t}caGS^`Fj{=45)pInlz{bd zHPExeKe@!fN8o!(rOO8|VMJ09^vy)Vk)}Q-e@)|TlZ9M8G7j`U!im!ef9bF4f$hj! zOGL9(V^?(|4oXZInkxM$0w&juwZ1pGRx*QbsWc~#nP+GE!i~s^5|og zTo>3w8gC}N<}k!tA)h6|j%~F#wvqkzD+zZP`*r&exT9S@OMS$?r64jb6qihVq0f0< z$dVnE2c9L7SG|x?eD4{pyuCyuC4bcT{m-${(R}iV*REy4BU>;n?*%On{d#1kk3j_e zE!+WO>?YguO_>`{^qCSg_*H#t)Tb@DU*&a|&Q7$Qp6YcJ{e~`bu%+q_nC4c$pCAmH-iN3W z^YK=|C}CxCX-o?TXKK7H{eKWnrIefu!$NHz&E~IZfOtRn3;wyrQsbETg1$o@DQgr2 z&75hrmlzf-&!26BDwgk`c9fKSmhE!Zws5i(pN(P;0}2sthobW(q{By|j*fCkV{eb3 zNGO^rkl<+#146OTFNzp61ql4V9EVp9si-_YG_HCm_hf{1B>I+rN<``Rd3-w7Eg8Ny zYGtP>;BXL5duDjIjNNysaLlrIjcc{E`O*72F-sfu8&7&Gd^F(G0cyiD6lQYK^}E6S zuN1rr3_E`$z?3NBi}U?_wfs&_mBftzP-&pvZ5d?VWJwNgAu);eF`c!WW}0$ZyubV0 zcvF`9Ow~dl(DvfJZNLVv_Ld%2mJ(+rK@eMiaUbn5-iXX~O ztRq*Z`@72lC(K07J3FOBe0ou@EHll)!kZ1;=QcI2csUSURFROj?Z&Bs+IF%^6&F<2 zco?Nq{h1O;#6}lS-h}@ZIlOoN`*}YT5YNA~=ByCkQ`!#jt>Ia;ID?Zi18UN+lQg3#}(wmJh&Td$*mFk zOGJ&pAh>eixYx`IT+LVsr8@DzZa3-l z38^|6Ugx5+yZs7lj1u2z2LY;;B=|x>J*(#66Bg`WoKacUQZ9UoC$8LrDKb4fGtIWt z37coKzGTx|OLU=$xA*;|YJUA5oj$>yMsgX0>%vdx9iqJw zH^-E$zq329ewzS92QqlbG$Pbr+ z*XK+F+_F(kes)S)COxY`(O<&x$|TK*vkrmbC!Y&Wb$)aO8Hm}{! z17dPc@l4BMt51h&j-duagY{5?Mg$-NQpJMk}J1>h>A z4zKnt-@Y|uW8x~@BBZul36i(5DUUn{D*>_rS#Gt^l+z8iM#oUzMvB&!zX-f(2g~%CDGpAnw)wza?!tWk z@p)%##i?6ljIVjLVfxLGZwV}ItcLluUoLWJu$t3L@#I{o#h-KQ7vzu6ftictiwiOjDjq2 zyh`E<^-8|Qq1bcD&;qiPefs*M>@}Tv;(Ecc0P5cc8xC+#tJq$(<619cTS8Hs^$Ijq zDEZtzD*e^EOh4`RA9VscjPe6%%uuvg2iXIq=d<&LcC+`x-cJXA`iFT-LXtBE=bHHC zRWjNwS@m3-l2_qg=)RZuCipVn#xGkLrDSeg^>4ot1OX69li7qaa9JPyLo95#+^FI1 zqhufrCXDF-6xe8(MdmA_DbKLVbpJ?qgTe;EOMlu(w4&dz@ct)W( z$I|5JLBjbY`ml*{%8LGGFIo1t9~G%Hrod-xHw{Ov)@%Fo=0eA7-k7~$#@4;s33PnTkNf&Cp)4q9v8bL$Nef3j&zM6gKP$Ymn%ia;c1Mu@JY zfZzK_lvP(=IKOtI=MvJ6q#U_uR&(|qgkAL*eK&n(PgG;4PHDdV^2}3Bf44=`hr_b7 zKe9$}thwq#(K|%T?m6K~zG(k|Rsb+CApJQ{arWsNJ%}g3$*<4ze045HjNzC{`@r26=J9nMs0XqIkvH+n~PK&bFU8ID-^CAMTGD4ukkDv%HYv=+~VSlbboN zkJb7;+A5%$XInUx`$-L(BqjPV;nx$$eIi&DI-5UMs28-_C?Ep)o3Ni0ZAg|69JZn! z>1Qi${zl7F3-{MPHTru5wx260-Ra`Q-c!$!!SM2`@NG}dyCJa}mj3R1Jr$7Kf*ZG` z_t!+F4+26X@f7#b&v%F1E08CnczIvqij%n?3%Bf%?&OOzXWq{{6(JURZB^7-A{Qol z!^fMg!N`dp0d0+)Ho+PsEE>qjFnPP#&jlvMwt$nD?|Kk1X`iH&%*X4S_^cc={c4V| zrxFj_LvVpQkbETHV;kn1Ry*!9JbB#6Dt(rvd8HQF_sF_4F{biQIXbuq{#vZe4LheG zA+DyuVa)AUqnA&;zc)aYrENb^94n*6ga+wQlU{gXz&NF$a>R`X**b*i72a{^7& zsR=*(z*&;caO{Tx6xwq}nA$eOJnp ze3^0=k#{Sal?#pzY@2%pAB0t%P-rAx_1kme=t&UqgU75tjbg%TcE-&=e4GPLirdW< zwfW!GepS&Oo>QA1G6cIFPp_)-@HF_g)U^BGH>vHCkAvGREpzZU=DCch|8dtGT91q@ z`lEW&|1?mTA>T!e)ZW=K{g=q<=9^26$xfkqx?#R}5*pTu6%uT4@dL^~#=M>0x$;JB z&piH-R_M;{c6=0 zjf{S}Ixf5(H((lJPG2vlUfG528nwz4k{?$)ZQO4;tlf4~mHD+p>O{?34SRfrh}(1# zf34SjCJ4MEY|FfTxSX(9o2<~A*t@BsmDffhZd)fL{?ObS&wFWKRt<>dZk$=1yl=OT zgvk{6Kzq^j4pVYoOomU55qQvgtx06qksi9FK?w5rC=6CV5VZ12f!U@0| z)PORexLmPSoBprv;!j3zuZZw6GDO{LMgU`+eY>m1F*^b9^PJ_I)rL1W%Bac&z%d2- z$N+g5_n~%n#(sO!rG26wjB$l!r_T9F==f61a-kcn66b<626sNdGn!06^t5x%R~ z9C*!Hrc9~ZNZ!sbH1|cZb+xIX;v6MOibVID>aNGiMH{G@!0I^7icfPSqxO$+50@3xcZI{1g&xFVq5HhyM;UXR$uB#4MCZ21iPcwZ)JI-@3YKX%`Ex-9G zw>jcze@5gF)NVtMPq-Q!*A#0fJ#olhs{p9lHAIOvYO#^CcKGcYrAg#8z%}tPII3W! zfbEdacfUEU+4kzR`o!iiz4``WLPfP~DFJR~8Xpf6RsK47%uWK@h}KE=#QAdi;f&c4 z-huyh>pBPwTww=UeADmc>yl5DXYX76&JnJ4_D1IkvFqX8)IIRu$+QtfwtvtanA3CL zr&e;v5}95nX}`EP%5|sfW}ANd$FT&BtiSYuG8v=}fV8$#FMkG*ZK-}!x6~O<)hGd8 z$Gl8Yw$)STIr_A@XQh_S@ngp#t~7_gV1fiwlg*J3!|tq9;>+w#;^mr-OhPHRcbAUl z7x_{%J{Sr}=LNR@V@%%58gB+KbDao=3@pU@9jw3O#=4z*3N?Nq0G#EYu212L`o z`!%#n*8{n9nB@YdONBZkxMrXR5GQ;;7JLP~#|2<|LA~_>&0+$WpxG=6{y)Ol+ zM8=igdoyAJT7j9z0imr6zt7;z3Gcmk0QtFCwGxkkAbfN*|Aff=MvDln{N^+|H!#TsTS`2m(k+vLmKfVy=kMTQS4GVJXW4l@i^nnJG zq`_POjN0_4#hxdScKw?j>Uw5%10#O?hq3=;*kzYt}v>AOBn?>s%rNhCWYV8PR?@q%Sg zrgv=geRQt?Ox6^z(^xMD@^e7sw&(z{S&Lffti4xD$=kqJ-lT0tB7HeOz58FSTWuj( z5%ekXVZPegLIoRNfZ;|N%sN%TS2C{l&!~I`iR?Iw0D%1UaJzFV=zh)`0C~}r5Bf%5 zNDd-BUHpTrZ}jEj#_BUofkhEm(iWnBs6;TlgW6Fu&-17}J@0-LqHco=uUTuhJJ&yK zGe4}dvKbg}2Ns8Ib@4&VTom&NeTn2d4Q`W^JcuoX`X4MGh_l2L0S}go-FK6`@=nGo zkHCsN6U40KHFKPue^1By^cUciJPckxv?KWQBqDnLN7g(!k`Lce8($E(8xVf@x>}b= z5us`kb+px_p$x2%tW2I`YBt++09WU`^F~R?VI$>Rb4}>Z7i4i2dB!|mJN1@A|Jk{@ z9%RrMHN2eG*A)#=uOYVBR!c-N3za=#z&%f5b_N77`>%u1J1@BAo?LTedZ?os40vU3 zP)Dn8hu};fZV23-##rq_Mo$H$J4uC!j~|eT-6-MiJHWe`>jw1}uZIEsB_nI;1|4)e z)4&InV)zMZ;7kx;#cu|%7QG%W2@ak1S>HsR_P(0{U*SPZa5u{%s(w$ZCMKlLJSbCVxep&;LoqV zvo-T|x#*wp$xQEXqKy}&P=vHthw$G2K(h@t3X8)DcnUla?s6szXiM4Ki^a0y@<_VA8N!SL>GTuLfH5 zs<-V{<&jITSj@jH{>RqQXwPHYGOdKNdnd1cmEdzTBFN9@KvLgyO%QU!Z@k*9`d;gf z?YPX+vAH$6m_Bi(Q7Yf}3tcazmDlB`UdbHHy;l*6c*A-3D^#Nytfp-9;H#f!n zM;%)>du>i57U^AUsT4S5^!|`|+PUk3S1C{%aC7{LOxY61za=%D?*VN7l0VH)7c(O! zb}Fs~!%n8ZbyvMiPfqJ2s1*K&u37tKcq>3lxZC_*XlLW6x0Jw2&d-TsmMK5FSVS^k@-DGpAU(N=dr!^9SMN^RVvph{dW98Ch+nPF|x5H zMx<7_ji%6%Yr=FKy3k&8ZCXc$SsQ=Xy3S|5h+@L1vG*=IF0xsHm=AbU6GmHZBk51fLo-o_ zSX+dg_igJrs|6b}GRx*o^3W8x7S8;F>t{gJ=ry(%mP~&tN29_QM7(x9u#Oh25-y2u zO}PhmCBii<-{dHL#@}h5O*NTMm>v92`Gl?#pKUB{cbVeKZV2)&z|FooraIYkO{y2? zs2l^-NN+IsaQ29d?F=UVWME2bzcfjAXvAW`r6a@X&B=1(>XGd3l;Mj*H`k~%5@CYL zu>DVyguLY28P4>Z9m1#26tmrr{~K7k%Vide&pKC+WEOy?57>BOdzsIVqqR_BS8b@Z zKa&t39(D&SDr;P-*c$4#b^*~OuKqYk0LO@8Xv2Ap1n^@0A((ja1?89X&+p=St(d(! ziH1?%*um>DId)(CxTXzKjejGRBB&xo_$~|YJSPHsQFhkp$7jPMhEbNsJ3?_q<1ybH zx*ylN-mMqj!!qMum~K=5je)^2RAnXoo(HX}xudmM`&tkqOr0Hov0IZS4tYA7FDQOG_12l@sKdGGAEc~~|&9+^y^U|;{_Q#G*Pm5Jl%^guBwKsjv?ohZ;j{XA3{eD0)A#I|dR(1jG%5mpqN>8X&^{)3ruI(quPJ64=D)}~B{`z$P zx0}L%&Kse%j85k7J#}X-l3s(x&3Zt`T67TIr_>TZ5bzzyQW!B^YDA5AuU{S_%pp)A z5F<&^;zkOXcp^7aCjAu{`-s_b_Y>>)E}@||E=JADec$rqI4O+1jPcYQLkM8n4atY| zS9d=CS><@$4`8@0aGLaQ73;U3c^4Q17?>r|g zx_(HN2;j16gN?(_fUHwB7hm4!J?VN2V9_($@f0W2c11X8Sak>bkH){(IHJ)Wf3TUO zxHxwOlq{wY#1Y+1tmN>QanZKPdqq5eA0!TZMLc3@za=6+_~3UCFZLf+UFr?{+yG!$j>cpC*->ls1Z><2aE4Guz z6?TzmS6XsL=SeC`3LxEHSW9wY)UWs_6U_<5l-Q4C)bXEl)a{~6TyrJ2XBdA*VtoqV zY`#GJe3vd27^R0Cis+;Uu466s@H5i*>LC*c&R3+sD^Z&P{K4VI0|H6G@v)L~e&UC#jqyJY8meuViA?){5eQoPq-0wxQWMiQ)jz&vd->&jpMNKx zl8wCZ_oxxk3Af!h$|y(l@H5MEEf!_16?f-PJNU>0*eQ|i*Mye+U4-`(!!}_{lR!Z3 z`b992l&T#Y{u|ZsUC$kb)YjItz1=SHTGx>q{$(glX(eV13dFiN|I(HGL$=lC_Y#YK zqR&B&qzcWtSYx$}lmDu42)L4@=Cj)I$m<10STe9YJCd8Su{DWibS5kMYMr7au=cjR zYI`|>BVvP?>f5)~X4i};Niy{}qg{HM?4H0%)4q>YrJ7e(F9r~)N&%)XU_>{V zl=-vRYZM8k<=s%;vMj>+HY8SMf(}GFopn%do5_9{faV=v9z|5q6PmL7>yVDkfxx zP3K+?KSy85TcN8q$o&yzlcM?jbq*3H(^#a@LZr{#57WoM1&yd9Cq$Fm|5+6VoBIHT zXeiY=pGQ@pGW-oj|FcOqcYvKv2rq@(5)ifQ0-F(v^7a@FEg6sDF)b&tyn&_WX%kP?#2q@x}`MJ5TXJ-UVmXOvM8BPNHC_WtkDme!iUj&k+X(PXk8G zdv<+SG>>cb{}q2p$+L*(H3gMq`m_B5xAn9*!z)d+wjkXeN<;W| zRQKvSeSJ+@K|v_iL6M!*Z(5!|=>8YjVtZ}Dam(}_BEfQK=nLPg2Z8DZTc76B)7|01 z)h*}Aw$nFFieNnN*T9nvj!&qe8>h$DcF%O={pr8FL!s^xgA7qff0``Jo|U=FJPtf7 zrc=3lcYPIpX7K2()8sawQ(T-_4s9&Tp9Us#Sk?+J+=)q4?qH5~ACpQ^z^vLyn<}xS`DL9A_;Et!q7(mo8~RC2;>-@~ip^MlwP!Jk{kwq@KS(Hm?@A ztb^heC^&ke<0cs5{0$7v?^P*N$=)TCC$TRA3q>kj8IPz#aD0ADJ0Z;>4RhTq)ONfD zI?>B24ZYFy(}gelxo8nrY{pr`a73SZ*?d;Nl$$#ep0q)e16}~V-Qcv@FdV$WUTL0)udZxs^sw%uSZg35Q(%R*~TbS)Ix1So6M)F3W5 zi!PzBJ7S^)u{SQhNX2FhcU})$G=Asv8}*#Wt85}jCahj!{0n1JoV=v^p@?gJA4P7W zVndl?orHT@HM75p%0x{Thk5GtA7{Z zz4{b2RfcXMRtv2fLV@`ue&}L;Tlq-)8$|TcuS|CrZ-r4>S+dq*kCSG@X!>8zdQ>aO zYZY`)srZMsQ1!U3%NOk+JZ1G;9foy?4}`7=v)7G`iMEVSam0tJlFF+;OEhFV4!5O# zHgcI`(TB^5Jok-vudt7jKl2E_dX4t5^WO@RR9c-NDWm7|+U0TD{{`mKy6XH1*B{db z)puw5K~GI6coZ>o%n%LfQg{Z5NxTQ+GhebQZ(=@3)g;^9bNU64!0KU$B@~swn`0>m znMjxR1yT3J*{Au%Wu$k!;W=EEj?b5xcUWqHBkJi>G}kAJJME`MZ7yB%#l^+BRxt0F zUzy)U0V(n63F0^-hWv$f*yFLa8F-^Dia?Vb_46YVj!$?pnf~w94btzQzt{(3GKi|k zK5BDETHgP-as62INwbpEoy8K4*tf#*E~f2yfWo>Jbg7oCY3Db$-agP7N$8h&- zr#05_Vxiv(A7-1j7Vdw9T`IMWsaP!JBl{LxTHV-S*XZ6&yd)nLFiV}&U-MbX|L4Gw zX};t7OdO66_FubL4P0yF9!ZB=WS8PSjHJ9#fxtnFE z5-AZe6ALP5{dosj29K=I+DEH<#4I8<3^UM6kS;P49FIstTox))ZQWwMY3adGhJvHg zWtca8kW3CUnEElk&R5@L)F~|so{hGKd8e(FE&!-N&PDi(;3ACZhVq~vl8zT0gw9QC z9DmJNTDcGb*Egp60WZmmk!!vLx?T)H(x$MSVk4~;`?{4Zp9Vv870tl@UIl7y$w#BR zrFv2F6YAqbbu|Pd^q(whw+jdJSN(ir^=&1*E}Hyzg3F=d6Tkizd~GN-a=@loZ)j-O z?{;+@SgL})u(2cGm3-5GVD-;Au7i+t3~3O=o_a2bm#|&>xm=GeZ50TeltzX5v6_fy zs<9Waeh}1WpQ$E!VRb5yO1F%m>>F4V%u}P}(RTAKqfHMhugHZ}#jETu;LzMV)JvTl zu}{N=Tteh39Fb!|56AOkXv0)!FacM4SRKB1br(aA8M?DY;EdBy=az^=oFrBB=6%5` zn`?!-&qP(ayQuY=(%J|8mIid76hT~!nSLN>)Gw^09`}CST;h0K!dekOr~9MaE^fb{ zJ*EL9^~K6FI`{B+f5K=y#0hdGkV*Fl^zcD)_Oj$IiabB0SAtM0YbxIY=45=-z=`&K z_qfZx{Y*ffeGoZ+^CVeBP*8Yt7g-i6mtlUFLsNTGYq4#zxRM46(Ky?G(f)i+wiAWS z7^V3HvFmp!?>;J?M@0jnATs*SQhxqd2=k#BiPP7`7emOD|7E@P70djW1Kt8$mlHaR z?qUV%DOlF~-s<&^^YuO-qbEz!p-v{+c^(jXNVIRR?k;|IZdPKWGNG)_^3~Hpcj~f- zaTN-~&-yW)t}WEy0NA5Nc)z{07==oPBKdZ3CB~%Obn4w}tnyX&M?V|u>2;~Ij1MwfL?!orb{+5+T3Rk8WAXHU5Klkx09@~zxgSzei(E?!i+%yF=uZv zaK1R+1M6XjTb#MzTcDih1Jzu@LWk)*Vu|p!X;qUnqzx#Lfg+KoJC*WT?OLIv-Wu<0 z+E4unfuw^;e|ry(1S2kGQ_+E0q|TKh!*OE$)oEhtu+BP#AitOVz})9POKVhO{>(7NUYUSd!DD05@VBHhQhz^`m0yE+os}IOHC~O znoXBX)_KPDMhEBcfCDr8fJMKjYE?cx)|h>QCbOSj)KqrcMn5Y%TXz9td-19;kvG8Z zZKhNLM@d6BZ%5az<4FbZ075}cpY0j;anrbW#d%ouI#2^P$2@n_Lbb_Z4O&5(?LFI4 z=_5<_{2Adp`?qd!HsC6>ikFx<0_FTcy~M9Tz?LRPox2-)Pz^wfilnT8gBhl zb0BjKF+VWeT#v~b!4`WFhrYM`C-0FnRn{EW1jZ39e0q>!%(Nlth3xg_eS*tFqiI*hA8BMtAhhdlt9s0BZftv^q9p^hmu>pGz07 z;Jy{#ULRjpUw2(o0^{*phHwwMq2goKk2!OHSK1|z;!RL_Z8lT=qWSs85WeFIAe&)o zm)%7&TKie(wN z?o00amS#mj6G7XR`6`mmIyl_=t==Q;4U=_5xzaW=qtW zh-q$(=3RrA1kEtNH(Z471OItutHk@A3jt4IxvYAC$v~IwmBe-zehP}%`-wI=hiRv7ra=#%u~ zX7=eshBmJtUO7W?3@yoP;V8=Q+3X5qO{MZY03Wq6|2=9^sHbA4AK!=ptY5(a67{hP z^`c7+$jE+Od}u$3&s^@JT&hrRm12HITPihnXR!~DPV`TVxg8J0$f;|Ezrj0>Z@ER) zUqYOsjTNmBT{`J!Uz(@JlDj=Ke-qmx!tQsJkwDnV?SeShJ#aEO(zN(oc zZ-F0{ac^gklt0PP=;Ve86ujXD4GpGdefTy^_%LE%^X%xC(0fLjY9-R!{WVHVxpn9)O~i*=m&psbS^5$#)Wik8lfY7;`CA72 zWg_@F7lcdu7yAL$n$q68Vhy8O9t)iI<|=#V$IqC_hqAo&uG1u5*FB|Qj`^Dz({gCp zTQ6xB1nmSM5)H>DfBPr!6)=Z=4^XTo$qOV|XXV`ZsK;n3euvH$5;JpA^WkJ$aWNCR z;Wl!J;<|y&{)geE8=4!QE14FVDAGVF1YETg5`avR9=N3^V{*`zuWX^3IXLn*iyFB# zp~9f=1k}8&Tk;AyqVpg`GjC<%4XpTv436w8RhtVuBx`&D&~`n#@3j&|a*&#y@FykJl9LnaCFT|X~p`-dRz4Vv1wC_>)>gi)$^RtKM(#ms>(PQ+| z@SN7uubk-L8LEDwYLc5_u0a{ofu%(k%p_qYyiwMDFP!_x<8SR-^&|V*bFRW0?V8j}8rdjq(wKtmV)(qdu)eA%$k3k2+_ zc3qJ)LmXyUSNS`$wV40pNtg>`yXNvEeH)Bou)Ga9M%u4yVl7?m;IAOWgm#X?&jsSkI;RK|eQPrC5^ zn0~@8vg2sqH>=q1B_ zGYGaDjEf09+XJ|}VU{k1b^DHje$2uK0o9h2ZxiZ#+g`VS%P}Hit|At{Ls#s|UgBb8l-O?@3)+LWTIRbXJ*$X?aQ(7BeBcKl} z?r6;ZcY}^fFe*zO3TCN$I_Dw=|xXD;F zX!0a?XRg@{=YH1qcV@Dflcbo1lT{Sc_NMv?ZTTC=$DYP{R#TQ>&J$sD(5b+NmZtno z`W$6}rkLikK+L9i{nsl(S!c8JsEy7Fx&*k8nl4ykc%Lq!LvD`e5dbl<F@ z8RZb8x0-1)O?Dj*^xXHv(w`hmKkpzB(Di|v#_33i>KW)34(M~H-i9ykG!d|Fgn={P z2DI{+W~g&J^Qwpn!~fFA2a%J8(4MMQWaIzYQycM_mDKr!e03xI1b2MN3l7-Fe^i4J zu)`ycU;h}QxTftm#kkUL@ojzXpP)cuy436oD_{MNSsu|(H*l^7zYK)GH-f7faCLW-*z5Q@Aa!lsPp|!Jj^b*I1mvAxy(3*v<4-{)m zT|>e_P(3c>zGnTKAmDv|*lU7hf~RVunj_|fzT0F`%8e(^=SoqxQw-&!jA6r zh20dey&-IAt?(~8R5&hA!N(=(rK#uc4itgCnSh}Y?g>mn@e1`6V_bq-X$4%GCWett z*i|udh47U5t%8og)jdGNv`1ho*JGI$HJA$^ZhE9k z#M4AWto`1CJsE&ORtCq6am}XEQ5Z{qF%)TYhj~A1>ffemBrRc|OK% z|BXmzW0-84I^fTdeuJb9!``LCq60?#v$%_Y4P$&6x}31o@+kc*W12qCE1A!NzkbmO z=~UxJ;g9@`T(llyM*x}^ukq2JdWi+vz7Tl_EsMwIAQ*%Eg<0U-%*ov716Y}*?eI`# z+Wc9%2KoHnD|ou3+Xv664eo20$@bBAgJrpXp;{qcFoYMJ&}JDC_-npR8*DWuohQ1M&vYceR$-~;X8nPz;fcn4c5F~!t@-RsxWlBogK4}1yVP5o0-O7v z`e(1hXK@_gL|Z`@0lBCO9;jwTj2HaH#eK+GQ*GidzIdIl74iZa)fn{|u21 zL${!2num!S02zs6?Ye({)|%F_SRWK>C^ssiR*1oRHYIId?d#+#_l}1o>!1I+^0AGTz5KCOUp5eaB1=*;-LTar-SrP`ALm;-S`FEPuNvyy^^9nFIa_p9&9gbu0+g0}$cpdCb1wP13@(`2z!{t?zw?GZCxp5kct z_%Wi>yQtZ7egUq**jYFX{cpKx^y7U*Av8*N@_<~!j$}ert%(_r74cD8f@tyS7fX2* zh@+I>@e8WT*eLTMwlWZCZPT0l5%A@zy&_urk~-7dq^2Bjs)%Oy0{^8K+~GNUBrv4J zNKI_;9g)NM)S~^g7I2Bd)W6L#q)7fqa^2Gm8Za+r0VB^w#cT@t7GiA z$ks#M zvr#>|5Xwe~?J`$z31P12`G%omN(a5rA_q{pz0{5yaeBWW^|!| z>YYTytfgwR(q&~go$sO9=z<@M+3OxG*&3-Zaep2y>9u5S$Q+>B}t_(o>Q(6#a0CF@+HQ7WfDbb|npBKII+j(!A{%|$zZ z8y-BSb+kd5DD^D%(lOG#AH>v2?8UYRo(y39tq2Nz3vTVhV=m&ySjT>UwSVpWxrX)cd7`<>Unh2Ij+lPB898fc2kyaG(ua z-)-^vG+77NrQ5mMInZzv*+sdAz65i*7*Cy&Jm7S^u?wzCt4R%R+RVdwjg8lM}mOCc0mL|EHRo8c6@h$X0*syTK0c`}L^DJmW84>NFc| zbo9@+M>I`L3efcNe`BhsByMhR6Q4W_;LYLm>`;gng(2`lh_FY@DutC6k>A7ab|A9R zc9h_xY7d2cF3S#*puoWWA?&8iFYd;k^7qQ{k2hx0lNE$;@qJ9(XPX)Sq_p8j79NS~ z*?!)p+}>;f-xsXc)|6ZaS?IzF^;Tljs`CZUYD?D}R!ceW)l(d6`uoGf`0xeZ&SCa! zAd~TvGmwe|1QBM*-;gE5B!(oBFJD&Zm zQlr)+udpyKBSSV287IsxsqJXBGc#W*vBqkiHGxrQ@NmBNu~e;+ldwy6;q@sIRFP&f+)h??#8j`i}uqh~MruCYy#5w{>B0m)^1b`nQA)nFie!?|N z@KhOb+&7l%KR4hUuGBGC`3|v;G=Pj*M0-`e3Wye@p?RY?}C#&O;_$HUc5xNb)NdO!(+3s6GFzr#xR5(V3vNcHPx zktTjX&8n<8a9wOz)|qv#Xj(^p`3gVl@^C&bFE5W&0xct*&z0495L-N&*jgr2P{*FI zPZ8TV%sl1fFRp&gn>Iu-D`s~Rt~dq(stX`j-H;h+hx5wB5pfB`;Ff$7E{!Y z+r!B%V>^pKQd934Pl=Dqctqk|?7PxSwp+&<9?V0hCm%2QmJX#XCo0ujlySJ|Vulia ztk(LhaJl@hp`i}@ZmhN4*VXCIvE!!x=J*9Rl=8RIMSD>73Jt{2{ZDv#f3H$~{3ciX z1pH4%=Nj@0%;k8a*qB*ZCOUR9JR|syo4!p=O?@BKJe(=l>I)|E=?9w@E*Omn_GY-@ zXx85J6f>vpGaRw1@{x_qHNhog%Lm)>J>1tNoM*gh<6lVTyIb_0y9f0I(Y_q7=Fp{Z z_Erz8`4N~}Es)$WQ3>_IHo+}8C`jJFg|D!); zKlby)a@}ry>iS^&8ih>qD>m5g9lBl5b_kU|sIO+7AH^owE6tW$>Uq3w>~bZdiB~A; z4H~T3?AJwu(11%oxP<=G4MssD&xpSbxZtsr4^b4XggAtTTb*MG|MZ+RfcAz zZ@{~Me+^~QT$~*qXJ1Y-PWCVKBWpS!8jw~KiGK$)MuD^LH&I#zUD#`2J#5-ff1!w< zthBd}ZqfAFqSymxMo^M5-iAgRKwY;FCRAFopM|IE_JM@MB0k~!_jTuj7{zuE=a=Zj zW%CW?V<{X5$lc70HT0Iec2fsd$JO0Ia<4TR zS-(4|L_b`pKllU`4)U<+Oo^$eS(IYihKZ}uJXC&y&yjL*!7JC#*Jk=o$j8f6e>K54 z%1G-Pmc$(t@nLHJfh89;llSk0J9+hny+4WDK1UbKppxwe5{JdqS`^>$_)LY)+Xj!z zeJ#Si0oZL1(2YMp3tJ^szSw1PPB2=Q{d)=5C9hmE1}=_V`xTc(LvrcS0`s$^%5(`& z)H%_yrUYOoghAf`$xd~h**?n@mxB<@cT=XB-l{CGx(}p{CEeV(;SkW2b8>RxNqis9 zSY;;vSTAOTv@)k)nEvtO^2bYY@f2>|oN?uN$G-p`2+Ju_wjK`*u!scKx1Ipmn`kiu z^2H-v22sK354=>!pYouwomACqk-&vGN*UILI`a+Z4AzrA65l-E=O+_c*-^#LRbQT} zMNp8Y9IDFh9Z^!W%tUaJkuZ~!IqN>y_OW$_?Q(VYWfbvJ%WT6iahF3SXu%x@x>u1& zR^kR3NS7)V$}ZKJPrll7P;ros^lF25w@Byl&uf+kUj`*+A^X(0Y)qvYn{n+q7v zjgt-fzG?*6jdsvwy@{FirD({X!tjcN)yv(9cUBKKXCBJR@nDkqMMcy$ZD-=n$4ku} z3|b9KhKpBYU8cXu-UB%UpB7#C~;XYIJH|Z#sMyE=QRbn%JfC@naW$L z3wO7+zu`q|&crZT)XJ7lH2!JQ#$yHWYA{m%)4JeZU+lC97|a|ev;2d*2q5C%XaY9z zxb@tNfq{W+wMyOXG#St%KsmURtqfFGo7%5|#Y1+_;FUe(p+e+bs`TZKuyK z4S@rtN&7>=E>~R%@U;coTuRnL_+ckw{vKfSqii;cD<)(dq=R?98UVx$KPqt3+?z>Czty%Kub0^xPte9;`E^t-5%Cd|dX^1d^6{her0%7^P#@jaGMjt!vYu%aHol*EEV zdjY4Tc5CYcaa3=oOH|Hz!>I%AE)T%L2K8n8v{HYnw$XQAw_jF~96L;EY4+A}0`fC( zExbs$5<&cJ3#NjeO8qsUqXPOfhrdz;a8sBjXS?y&yjTs2d7|Lso+&evb$bTMfQiaJ~;2b61v2-}{}adClhQM;SBR6N_w z>bMe&@t;Se?FLj`9WB-x_9B}C(Rl-&H827JNkyS#J5_>_UEY9S3v|Jmb9L#swFZAg6jNyaGL9&79jGRz zqIb<3jj?X^XOv!az`USjKe4j?DrKfpPY7_Yq$LWuFB6PuYE8$EK`@lq1yjiu3i}xV zzkA-J3KYwgbId(V`JkI$MjP`F(N2@>d@x*KOQ+2mH(0MO?cL4h-%xk+ zYM_Xn=wOYLFo|W{oN`)>Z(Wc4o?$)PfL)AXR2RYKQ&ABrSFc`o z1`!l9`8#9(m73!&f4Hd+M=Oy3m8X@U=px(`q!x)F)F>38|Tu-h!nO*!kBtkMWPy}>1@oH=m|pXCWa zpj9rDIhui!=U7GYJ9Z`}8)SoSI$|AIf8oBJOkdrO%|RM51-GZ$9n?wodzeTd*`hq^ z{pIpIe(PQFrdf>u3C$}XNoOlIoEV>K5w}mk)rR?39LP1=t_qH4e?+LvMMS?mn2iQY zo}5x3@Yfml=eLd!^?hBZZ{YpGhH;Zc^KF&6`@iKYL54KrGjJTI)3x-avrxR?MkMMc zrGTB`_3v}HecD@p?8@_aqu7!Hq4B%}fj@U-W-}XP)0}XTeicBxIc?topj`8$=HQq< zTx_faIV2jp^ARpAJUj%u%2|!U>bD<4ZRT!)GYe59Ef#mAo$lyYW`DGYzE~IfVmmQF z$PB@u^XnItw6(to2n=L#JJs)Ij`-QXAeABSyz!*Ta8LJl;zq6MMpEFQQp1i2t{m zlezzZUL;=PpFh1Q#;sR}=iT**TyGdodlb23EHFK1P)?Ya<>V#Y0mcktY?Gbfyw(gd(LPI$P}tlR1Jmbn2`6v=k?cR-qNvQJR<9iMR_wthv zy1gv;9(jhLePmJ3^n5~jWtjs#0NypCCDN2M!#n0wvtEz?feMTYipUAu!5b&*OUo=N zMvwjtF#)atRRdD~zOJrZ*f5eZ(LMcRydjdx8!Y0uO#~13bg__sqChjh3QyM2wK(k= zN{EYl5Q)Vbf|!BbdSOab)1DeVxOP3HQtVj{1Qu~skiym;k?wYLVg+#mTrg^U3!lVfR> zVj`W$2n-IHi15y6`oPFYIhyhruN1*{t#zr2L8oZ;vug|K@2H|m5`d6 z3L5yhkLW2nT>Dn(vQWixnwO z^2x*_@IRQCP|ES2^=Mo}c|a(H-)$LYUFHG~S+zoY0K5ncCtoI&v(9Gu4Mnv7FWb&XPS5M( z-ktNU=E{u(dW~Om)kZLG0CRu(^od&0$M5ja%IE3U6iEAyocn-r#Oi>%4`2xYFb&u5*HdSG&x(pXb%@N_hPUveFXxrt{WE;89lW!=$&U z>ZfeU$5GMVeC!+d47tEf&ASXCpHfQ=|EwdW{|oZI0{XS3-g1`l&%N1Ze=NOrQ%r9- z9-GZl6MrL=$l!B59}eXs|imG8_IkoZ8I;?#6kY< z-PrBTuOg+wsA{j4G4`Frw)@w|dDG0Zi%GfM177dDi)^3AJMO4%5M3s5TEB@F zxWWf^bjfK_2CwdUqd+G0cl-5<=lZj4$1P>F;2m|;hJ2@wH!!;nhI(MH8}0qccRHAf zT=lt+1iLf6p)w={5lRSdr`rCb7j|%TB;c|k1Q6znu`$lxC5+p{S)cpkk9=C92|xd;ts zi#MH!re!6_R1#0VS+#g*NaEo(oUT+pvAA3NAIC1~C`n~dq zXaCQIW<6L8;`II&z0N%6RkEUm=1f(CM)cq3OQ(zYK2H~dgp1@A4g$2Z9f*2g2!pR5 zer_92s`G5X5iaIzI9Fy|H7%4s$J^4$iwuJMD)#HzgOp~Ss-=YxTq`Jz=GnI+AKwm` zmltcd?$&Bb^r>}o!u<$qdq>ve4h=>ylM0e!($cgyA4SE*UlS9LenS`h)M&H(ukCwg zA`YEumEB(vVvk)iTt@AF0H=qdi1-F5yZ0^*?@HgZC5^+0=u9PiNGAN}Cw@i|_&xGHih@Fdh`COduj=FrEgFUR`XAWzSOB+R2Gv0!h^5Nw(%o0ZuI{(apF zk2?hA$BPxiDC_E{#)1f*ZLyga3K59RknTCvTetiWWT-Hh#p(8S?%x!!bn%~g49{gM!BxIQ;j7gLKkR% zsu<)u?7U>+)%3h^I#ciD4=gjh)7vt4z-1Yy3R~lXDoB1IW zd;1+iEm%-!3$=+LU<(Ki&UAkEgMowK3wT_ZH=3H50Ac2V4oNtmeXjRCki8)4Th8G| zPmO%ZA5D)}i`Deu&yOd*J4+Q=K;%)C@Za^M>R>Kjc0jI(?;FwOH(_STvRM3hiA{^Qo@_ZYKhVtZ}vEBsk#})r8W7FT?2O#Xn4zoOs#q(ucjU5f4 zCIZBa%28i=72ebQZ^vl$b>05L1BcmNJ0>XQ;J~WW>S7GCrqUVw$+;5e z$L8`$kEW)k=R-`LX}do4){C5IB!bc)^TZtSaG$MKs>(374oAws5ShTBm7(GnK_Zlq zmPT07ako$2DM+VU)@2VQV3}wuYlp()S8q8+tgfxz_hf@jx*pN0oP~8f{hZ#_*wtmU zSnSu?kAP0p$5g5YpYb9A?!eDLcqROVTQvX^H!T!acKV_Q;d9YKQvT$sAxN;g+ir3b zE;T14^}G@7*<5X9%&%B{<8C$^G-)$7!rKq*chO81UG>26dvjF2RkWyXps5-4nZIm& z1>rq1x?;UkLuHG^MGu>`NEPC1HT@u*4_A61m*J2hMCW^3)uo{}YS$=JGEvqQJrMnu z?@WXEL5P&B$NWDD-$J}P)^s9drKC2RcQTANen*1tX{Z=%{rf>y0UdvkVY?dP|h zVUL0hrL*Jt+MTw=j4>KtE`z=&>j+Q7beQ26$1qWP-%O z&vIL(ES=)E*E#lv?(y&MCr_az`|SH(_aGTKN%QTh``@B0NFT5w>V%-+z5K}_3?cTp zF#vi*x8ij!Q_*_NyU-xusrv*H70@tHQBm>cy7Sq4!5aw)395C=t*)7zf*@vpiTb7| z>%+Gy`f%f+1Qw&;ub>>>)9sjVjnkfD$McgXwiwODQ=x3S`|$$ z;ga?h_6n!~&@HP&_7LC?hXC5;VSpU9OsmTgx7`{91U(z|v$}jcmg-3lXJ^L)hPpbF zqrmo%LB6t_39HYAI;IK1sln9yYs+RlY+eWBpij{{fD-|oC|~-dUW%;3rvC#w?YdffF~HhWp?zT> z*ZZn0^`+Q!jI%ygjS`lmZKYy6agAc*TGx!2nb&2xv7jKGGYVQ7>*{;f5*AIT&c@+N zrRi7re`8N^w==GtGX|PfeilZkL_4y4e z;&kQ&*&#AiR!u1|Snmnl{gaOZHb)f5S7f*hgY?eYrAIYD=xiCoa9to!0r^)Z{ezkE zBmqy(76C^>ZAh0pMRkLPKdLH{d#89RP=&xH4O1 z@KID$l$4PXEx|bbf*7C%R6x_-6T<^^r(U&o5!%$pVY@;|#Ou@r_UqYk>xtpj;e3_# zTab>O)p(ZH_}6GP|2iy3AMn+t{Kul55C2dgS%CW75xCN3Wo4CJqTA|GL14V-*(qN2 zp{+g7?7a^%BO=*wj60E7TWiQSTeuzl^GG$Ql=y+kNbi@IRoeYYTo?pG9Tv9loVvdI zSAd$PUvMMHyU#eU2Sy}Ie0kOL%gW#7{-sVN$S5y@(M}4JRAwW6pJ^dwS_6W_H&yRZ zb>Y!#UYIPC_HF2=0^RpamtV;v;@Jyz_z%5t6_1N*{IQ}tqf#ZS8KkC= z+}vNE^a0Z+wc`uvC=~%QE?Rxl1l9kzV1%^e+GDZQOA*zkzLJO~>f2%VTV_FP2N$ z6ReIc-+7J|LIdOP1PYSu52b=sI59Q6i>z&1Bahxq8q_1Te&QctTvBu2Vv)7xhOvuu!HDZV>3?jnX`nBz~+z+(1 z3n`-?L(MK`{DR61SY7N8w!c~pcwsqh`@9Kyoj*HrK!1@#dm)!+UK|Ozd6+iqRf%fv zX}r0X2P08Y@$AP)xr`e0Pb@Pd9s~%k^b#X?NA>UQW|$(J2&R-7|Ke-m@fL*+&-!*K+=<7yisjDz^xo@@ijrVg>sF*dW>4?~BaX{{6XH7;%tRPozAufA zf-CdAs_r8O4jZ(=FU%wdOK{S5js}HxuLxLQfQlz^kfg>WAP5C{wBb}PbPWxS-N{1q zyQ?ED-m-lWlFp_kd;r6~m1I0bf-H3U8Ia@O0jkU%EIEFEpxNsMsWu|OImxT5hXe$? zDAQ@hZLrR@S#B|#EEv(q7~vAi1Jz(j+!KxaBh3}U+QavbUMf{wD{gSWXNm&EIbLfj z2e@zpK&Gfy>BC4$N{(0P@I3%GDsZro(2L}2+t&Fwe0#LRaubC0h}3m-ipr+gCHB$k z=4oUQ;S|oV5<=filZrzdX2I96cTL8=9NgwV)k8r&EG4veb!wrod%xyJ|9D8&^K{DV zQkD@BWNn0@noo%wUGR>>o<!{nXi^LDMEY57a*!M0FCcf0gIOz@-aNXVEvthg9C;c73| z+J?4t!!iUs*O`28Q3RiEj36ED3 zvi8|Mb7Ka;4~pow8V>*2`r5wmTUR=!{e5Dbhvp@9DhSC!VDt)6HMVclj)&Z!b$H7s ztTq0PHqE1^XwW#kHdgK~nd))Aen1$a%;8sJi6G4aVCY~Q_XC1Hq$xUw3(N$e=S5EPppZ<+npbagygDMD$Ry3TDU7zK{%y7wniiut2$_9H|)?WL#dB_$ewW1)8T2ZYzuiV3^-F7th>AzvtC3I3_Df zu@`kg%aQK_V?_d6(B)*g^;&x<@OAnG&`A0|`|rj(MFCehUyiVLgd%po-0~nmnmmnn zNRi<|(3D6?K|@pg;7Xn+$wWaR22&;H5+!M-_xVGE{jUr(QM^rcldz+?8Jl^Y5D^#@ z#EJaRJa%h-$1N3ygv$P#J3H@~n8qMowpv4a;J_D6zwD3nZ?s9d65oj+G&PPGf&a~+ zcI4pFVqk#q^G7^J78XnqM98Q3^!(QgXkzw`Xx53~35-R05rY*n^qb`O$cWHs#}!eB z&D9u(L*D{QA#hR(aK3%4ddOCv6hKfHE~0lpJAwqrL#%$J2U25K0b`ny1DIkst;T<= z^euLPz8Gh>=JQ$IOC5~0OnqCcgvG=7ol*Tb`$%57`~~4xF>DOz-22%_oI#P{jwGNn zd>${=hS*0gYaEqTMM5Ga6xW-$U+7c~Kc;4tEZ{=uD@0+S5)Rd#)oBH^@Xyd)C$g~c z@M`yS6V$FZ^BT0(^%U?L8D9xyMGH|J&8{sbt4DC4B0z@Dr?DX`OBev=U@#$=GQCdX z2J2GD%;2bEXfI8eh3Wfqa;)^sMr!mvR;5>`Y@e~2p~JHQMLxZtjyM5G$dAKvhLoP3 z9>4#FN z_#}*X=C&UmweXT_9OX~>n!I_Gmuqo^8xHA3vq6YZL^#(VU_0=g;?$%0o;6*^#)gs8 zYA&m_qE*->0i&vF*Q|w#$te1e5PS2=R_9Ag!!;FDBal!K6>in#6%}*JHM-qPQ;mR^YtBvkaV3Gk*Chy5kP8s34oaQw`L{OpA z{CwrcuLXsV$DckG-hu#?NM}|JmYbYU3Xw(U@90Xs4Q;T&g!y+vQ{m|dX^8g6bm}g3 z;gG>t^OQ{KR8E=At*wD5kq_?$1c*>@>E-E%?vz~;z*truX1Wft_HX>6fv60y zbQb>|YoF%>QN8%bdbPH8Wn8kMeljpBf?Wcg^D1sPvuY>cyR>IwPXX}JOeye2C)EI| z}LkqnUU=KzEw)HM;KBO zF?RBjWM48PvP`0etXV2cLZp$MA$ug1?X`?aW35DtB}$=W8B{`xRj7FwOw-61(;ga^9p{(|Z$P02@2(kUA-+tXb+q6Ab+{nb?9EG^OHU0Rw z1DP9cEv>c>O4LAZu;nT>0IcO$ylV;d`tBFlauhti?sTWWGiV9Xe>}e zeFk!B7*LR@u(T%$KG=C(RKx(3K2<=eCaspBq>B|&&nE|7c~^92?~Pg6)%<5v1y1PJ zcnhibON&2Hr;fq=%rA<4yiFJNp%3V%-UKZ<0wBZ@3UjAcc<^k$SgB~i$mfV+1Vr9LCm?GX5}cW!MtVU>?{WI zgzsO7yDHGP>od8x>X}<#-@USrJ5mzT)vFus%q83r7vbpg6cuc44{kif3W=>u9Yf@` z^32!!956bnqD_wi9JoO~P>V(zLqS?)3^(L6_6GZ|X}gcyNTw=$m!5CoKi>T{ztf() z)c_pZng(#at;-pOTOYo5JS3I1?Ac_tZCC4q0{p!| zSEVEU@_nkNg%rDDx@#^-e15C9TKwblJM>3sZ*yaSO1j^nS1r}-9W)50G}nm9t2xl(8ar! zx}1BI(yWvh{8&_ulZ~zD1Bj%fj$i83W0+xsD6TW2d4s^s(2XNS_1}Y>*Vl8RSqtE| z;u`D@FMuIVf*rg&Umroc{E(^{*dH71NB-efsQKEXJ|uWm2y}{4uk;m9zY_ZSSX&s) z=&vl9o4-7T#EdM^**r+(uSvi`tZ^N;{g9yN$|)?ID5MplTIk+PKS?(dTx74wirSh? zmv)n3r7X`~N112kL@(`;C?{mQZA1nBa6zTi%ld&gz^A+l&FoJ}n*AR54Omw9my?j^s`tGY&ub$S9VKW!jLk=1>H8ll@{t;_X^h2-E#mADK zc(DVMZD`*)TIaMgX6YYZNL39KjcT1M%fVJ%t-bBgDZr4Ht}9^$xSrhup)Zh) zmCx4;oI-RfbhV8IO)OABY0bo$p76;RtDlPARg|3X*s^hF?wkM@*y)Z0&uR`wX!G6q z))Ex$Il%<39uX2#*FG5F5`MmZ9+1o75g{S)7`f<3Tq!Iy83tP8)wqwa&#wDq7461aiE!BarXd+1x)o0x3CdVza?F#L`FPg}EN!3hq?C)n$c;?rV zosw?-UH!KRRP5>|mUpQ=Oa~unm*-6(10u|4Y3NmomRqmDNU&TDz~znrv^xl#6XZKh zuA7KT%?* z;tDv>5P%E1&b(R%^8CAZmYT?4n!_3vRD0VeKL^NVW?C5Mm=ze@^Ej0l?la^)io!l) zDpS>FE-uuZ1~C#r2j36v(dm5X1x-J&(g97!>*9q0-s-dSJ>`mrfuUhBfNYbpU+Hq_ zI<-YH@@U>JPf1IwArTjN{BF~yjX8>rmMK(~uP)YHQ?ax#enqb4=ZvPukGvFbZburO%sbt_{HJ^ylU0ySfn+u}kCehQeV( zd()4vS&%XNtdkfhooa89D+@g{<6K|JShvevqS<%TM_oIvVIFOEH7WX# zXL~T&Es(051~+nxz6^&zUnU})VYq2}Hi5b+fWIZYwk*j2Y?)OrtJ;G{k2o6FhwbVB zL^oPpU7bzz7T&*4O3RLyi^kxdEFS+fU+>xTn6>0l=#b}t@ziLN(k<_!#9G8h{+9N< z#0Mj4?lCsHbsNm0d#tVU8p6me_JbZnryxf&^m;U?$N6Wp&fj2vZ`ak0Ngarj--C*> z5>RNQmhi3d$OIdxFSoalm4)_R6Sg&;;pdQJNA?GA`Y$N5b*XnGr&=rU1l5*zi@|a) zL!*x&ft2ir_#N;e6s_DWoZpTBn#B@O>Cp>xPc&id)@8PB1k{Z_J(zh@$cVbnv@Z-hjt;aRDpOr zJnEo}m{Tm@94JJMvG6|&y#O_-Hq9z(4&M!F1mRroBgso=+7*Xw)7J%Xn95sb7wRwe zuhmAou*cO`reJy&%J{6R7v(j~TLrr=zAX%1sx$IeI));pICO@>bbO%*8dLb>IY|2= ztC2noq-Pf3@9%!y9#=B1(gSB<)?>#IBmOft5u6195mYkJZ-Ge5mYMs+8J70XPBz0l z(CFLb$hV}7#o(Tbp0{9H73!mFR{0~!LFdt!kvBVX8W?7x!v5zGeib`2i}j@W&%V$T zhE~|J2<~Hxpd6&hJgKK<6eD9QxABw#DGT`kjXPaeWk`+h#P~t55C>>)(bK1|Vu=AM znVAm{0#8s;G7QjlOuJ&bP5L?)&b6`%nSEXb)&Gp!kKU@pY{H!~W0v1h({5T|pf&R5 zQ@l%Xa^;pZ)p|ENJ6WK(xW1yJrX+&qNp#ALBL+(HYg>Xh2dr@WC2*M)bij2v)$0j_ zZ5CXvP@*BwX+PPXyvI&BhOxp>h!r624+TmEXCP#2!#J2ToFe&W?ZW|DkT?rJL$_>& zA_?6^koam^Y^v*jv)i^4RdkiwuDi)=i27ZR&;(GO^G3a|AjOWMXijtLvoK`spRQd% zBLjEJ^2?-glEjHlz6i{_7z6z4+7Nu1KCyGP&OO5lg+keYSWM|Y3vVQVOxhIVR?p!S zKulI_S<(imn~peMB`PQj^zGUpXuxwZKtGHZL` z0jmgi>v8DoNi|g@9V|#$pNZW)6SDN5J?<8E0%3 zq}G)_1fv!c6@>v%#=6!g`#@7?W@`F;zTT16>6JHS6;hz}dp=5opvwt?wu=esP^@|@ zhRTr)I-)nOoLkbYkoBC>2@Aq$|&sRJxK@%Pe1S!UrY*;p}9_zXTzYep$H9(Gri6BY1ox%M{vE{I$n%U`PLI zAyxeiv7)ryUtRnJnaA4%QaOLL**&?})~KhN{$@feJ|Y55h1bV$@?MnE zpQ^odeHo-PCD!D1O_Uj1dTJ^aUe4Z}YhgF_N2;c1bnqzp+&|ElwvDG=Y|mo~@7O{Y ztNpTVOFgeGe@CK7mrW%o%m z9*(1n!hgD?ic??C=0tt{KE)}8)7?DF-(|2BcI%?Pn_KI~)7Nkjcyr&Z|A|oPU9Qj^ zqmhCLZQN|ts9Sq2-!L=Oj610TDs+&@epDvogyJRtwnWBjTbl?S*5H0nrh&&7RR;4m z%jd(J2Sg|N_tx)qn*y#@U*AHF6;~Fh3SnvLcw6IJ#)hvspAb9v5u)bWRr+_`vos^9 zhMQc44C8`VV~V;}8M8rSk>|Z3wU?vAEY0v0fltk}z7Cs~i=K4P)AD|nSfENuWiDbw zO^@Q>C|M+eF4k{VfMP^Hnhjywf{sZcn~k>hEdZ|y+L3wE#OkDqONT0Z{p}@i;gFAM ze7T){7exSyEBC;z*Bg)7uG`(wL?$b?5#Ank6g1^jwPaMNVz4wi$8>9OY_wgYq;2$` z&{TbFo`i_c@4Xg5Ei8jZ1d57 z(4LR~q_{0kM7>xatdPducjXcuJZ79JEpUe=RHN;v8865Tle!zc(`u#W@zOBDcc1C5o^H4>DWTFYRJIu=GC;{flYmZJzi z%VY?SwPUQ}YuHl}=k>q44z#^ku#W+3D+M5<%4kw^fWwUN@-Yc9b#~yn#Kf3xJeH09 z9fRndd@tyGD}-hDv1QE-nvtg$3*PPHuia>L0yBT;&>4QDRbu2RK2ngG0oWN`F({Dk zi^IRRs@f3NR^%hbBxldWDfo(hooS9Pk>8WHKxHr1_qsqUt}|jxmWS))#R-+^m^mi; zL_Dn9d%HiViB!Jsre0PpC||zwaEds6{31qhm2Fe1`)I%HfBQE}AQ*GD3YRs_8?O_Z zBaWoT-m1SExTctH9Qv;J^2jX4;SK_qR;h%f<2S}aU^aOZQL?dT9Z1!=y9Ss0GlCjk z>ZY+nifzTY9m;y7#yAPBrR7C!xHETX!<(c1zK7lLM7d{FTwpH_7;JsnLgufg9@pqY znOm^NYp`AgtlCgFP3BUhuQ)0lkvH*orIWof@@`Ie7+AMZo@JLAqJmPhXCBGMMj9;m zSa!E*O5WNp)PVhx$2C>nLekOvUFJuZ(EBevws&csWfWW+uB)P+nVyR!s!Yx%U;i#R z9>yMJ%^(62RIw3@5!k`E@gg3FNF3Xo<^D1aB(}X*7dcU=3HtZN>zNyCMHy}!Ls5N+0LQfg3 z6kbZH_Ka_4k0T$%S<(dlsUpgYV&Wh2D`Qc8815QKkRC+?r-a8}-+U}&S+oDVrRS6; zk_50$yhlwbj_~v1_OlwY9{v>+aPVwyK*X31X#DN09Lj8eIBa=7B#rNJS1*UD;P&n@ z<+-y~oW}e5SS~S}!}U($G*&uSJXX|1A<1T)99rfJ zJHgJy{yU%l7`Wza_@7<3Thp&94SGZP5lpYiosW3evUc$KDQ5V@c?>N|HJtW3ds|kW zb?3ocy`?#%cL0!|IczAEr;}J8MBRUVLIdxmJYS;&gd5E0jYhT;U6(}f|D7pZw|{Ns zgm3>~DY-h6Dsw(}5a)&_pQXU@$pE5HIvhA+t_|bsL-{k6)Uxewzaal5*JO>9P9U%Y zSd#O?p_Ma4{2S+obchMkY~d*>ZJI!sF2YQW0gkK#fCgZpE#{cMcH;(?;XrYFZ0hrY z>Mn5UDpaQj_zK+N6A{HTUv4x=W&6xrpEr-PD!$j1x#5>fXgs4YdhhR8cNUJI(EhAtV#a_UzZCOM~uy=sCQb22CX{q~aM@mjJ)l_T@P75<+VU@?(ALE@5N znIk-IMp;$GEq}oE!AAC0^>@@)I|e4at9V{f(nZ2HJXpemL73*vL{VtV+MpMeK3=g_ z7nx-NWGH|^s^Hn|-Y_LiTzPD19Lxte@LU-=0?Eh1$EKL%LrbnWd9s#Xg30;shJU}3 zeE(%e(yw=bG|(qyu=;hSD4FK_D5(;;LF!ZSn-byFSO01@C~|Sxr_hOJU^0`RA*nshfGG4euFtd<)7By z#ze9lZlSrdRvsZ0p2t6>nvon8)gheclTunlspkK(7Q*8lqJ1@_dpurSMC>$^iq>yQ zi=Lq5LW8Csb$hw{qT<0?fR#z*LO`>j^AD#T&q1vW@(y`*e7Mno2>4-8sIR}r`IE6& z%9Vbt_>b1T>6E>=7j;iB#AY%=MW8It*71&Z>7q7A#^T!wY8Vc&`Sqt#Vz`{_2lbyD zUs!jlGRTZ~URcmGGoS;qqD;U?x+f8}+((BH9Zd<>_8(A%&io9eUknYGwcXf0N*G!` z7T4Ao=w-VpG<;c*5eCbW&h+ML$1Ds?C|}W6E70y(QX9P`Xkft$z;tl5a{irQKt4cduSv-6%;(*&A+C;th z%=@`A(EjHsqD|aKasC6?2mE6ft!g?qns6_wsa#2sw*(FU?|cSNQS3}huiZZTGmw5bVndE? z!8YFaT2uYn?}S}L=heJ@I23q=_DhFmLJ#vqC;NVk+QO;Qh8b-L*Gsd1pb)u`kQx2G z&PH0$CCV_5GD+@I+O~Nrxn*k6BX8e%Zogmu7(YNKkjP~10^4!jF@ySnn?TRmF{FL`WLc*y;;kil&U(D@0^QC{-CyYA0VmLQt> zmN3KpjW92)SMw$QxyKR0P@MqqXzv&Lj_X_GvrVV}v0tg$&?Bws!GceVef-Xfl>jHR z>A##hD}wvhkwATto-KLvc+O_g1*0cQR;s-Vz&UOGZ-@)#oFvT<2_xWM(o>q-ITNb% z0HLq*pYsV&9=p(MLXpxi{5Qb+C?JRfAq5dmj=%o-Lz!1sgQhpRuaGM6cJ4zntDm?ndt}HZeOBTQN2tyTUg_WkC4k>9`zt@jM(dVYhE>%yWHBD|fdbV)TlO zAXqfL>4icW*(CmX{jQ3Y(5ot#eW1NKZK0hS_79OrmP) zS01{7k50@}CuC(mgm){b6IANwq)=Fq2)T1u+Er~nFGk9a3B#{S@bu}wv30V78bVC+ zR>aO2X-+@ir2Tj0>SnYzm&@C_hK07#Y724=J*0RL%N#D?^^3F!tkZnkGqZjxc@V%n z&VFhCrZiqM=iID-QOxl`LHQ#BAt*o$gYga=e?ZV*qO6%e0NhJ!r@l%)FBpG=;}_(VtA33cUN%u(H7UYm^O@QO9#d@HMYvLwO{<>0Vtb>aauhE1_oIJP}Z#cZ`_gR zRK?Re759Bz<>i8{BwtOFnQ~k4$KF84kNh`W`a3t&CF#^C_MP>}RT2-eKd$^)9OE5pdSF4=A{0eRFPPn z0V%#OdY5{c_Ips6rVjRzw=S(e*5p8I@>=?T2@H+AfU!juu^?E zRo?|E(D~{7cqmRdG?}8)O!WWq>2wVUqhf~6G^OVi)j&n?ybqW$m$r&qugstCi( literal 137969 zcma%ibyQSs`}NRW(%sT64FeK_(o)hOCEeYUDll|Oh;)~9cZYO$=g?{CVAG8m{Ns2~ssl#u|H zj*#sEe;|IAlaT^Fzx?~voEHncgJLhMQt*ey<>nw24ZFE6o1` zN39qHq5{2_daLF>f4F4st~RwCa_W^MA&VR|=7rD1tf2h15JRPc3=KI9)fJ+KZ}Alm z<}DM=+d}6(y@K&*<{(UzG;HKOpVtSEoG9@6%20Sbci$O&Su@w%hwFhu53_g-n*X2I zGl|VYjXI9h%ZpC#Jg7d>z)|(~pFcM_W`~}U5D@fSXd$h2IQ&*6s?~Tnz$@B{tH-e9 z$T+-WdS1OJDSl>tdc)I}RkWKZUgMuDOQT6!`r;@x913JMdthaIj&fG~JthDB&=0nI z$?due`7VOw^t6{UPfsx1 zb88^}&6hE81VS7HY~a%yhdYANEXK1@KoKOo9omCU9_Nd9R|n>ci%Y}hYn@J;80g+2 zeC(y3mX?;46ML+i^6xzcg~*6P;ZhYj5fAL65>h@CHhKwgvT`vo$(Wd!3{`Fo`XSV` zJ`Au>y#MxXBvUf<<8P^Nf5PuG1f5=UG+)HH28A*DhlPbL_Ah(vkOOOzj(x3AKF#fQ zWqs|o?34IS>=7?1E@@VXmp(_n{}uf*$!x0_gJN0-`Am`prQz^eXAKpRK^ysub|O<7 zN_iet2H}N%vo$eGB3tLeV3A!lv$}nDb`U+?>qsHb!%sxePQT}S14sg!POf^91{=m| z1pl((!_DbD7tL=Fut|;#d*eB1KKECqlldw^WP%bUp%mO3JrIsvdx3_jLai#-XRr_R zk+8i#nSXC2`IR6iuRpUm6IJMeS!wl~t?t22^uwxhdivlMx5M%U*F#2obWdyD#)MGI zX|kB8sPePf3gfB(uA_xoH&PLIdlK=Tku+jXLx0z}|DMAL_->ar1cUV5N{i3j9|zhh zvr*UQi}TTQ@KYBqoG&`6WrfkkyE70Z@Caesfog~MYe@4u*ox$jvM^`}{&&e=`(fa! zVq*@QhJRK?%r(`Y4iWQ^@Y^odt=yjP2*ctcVUTPtR~XAMv@O`R4nxGA^2r%!_=7dt zUjae){_gq&tF7Fq(>^zM{MTDJ9-E%d9lzmI)=dW=Mg*Owvod=q@WLzygKsdjs3WaNrlPBAoC7eY6C zfK0+api3W)2Y2^X5FI`zS9_<%h9VFV^Pvv-67$iJP=2J@W-CIUyNgU<^X8NP-OV$* z%R!D-&{(aV0SFPe@mkxZhMM+9w~Skl{mF!DGQrRMu(54w3RnnyKO}n%f}_LlhcN%Z zR>2TOr&^ENEF{>?PZr>2xS#d=oNte|5*k8R+x@M&S#kc&7r$sen|Wv#u99I%x3(Ox zlX6EZt$qtZT*mLZtrx!}g3#I*{iJs}Yi}Gmq~N*Bvv?Z&<~H^U}w1gvuouZP#F*f9ApW`fX_ ze8&61-_qALzURYQHuE*jGungqC#|E22EGMp?EkGc=xre4-vU(zP)|6qDjhfT{>){O z212}mM@K2##Mp9!AcYo=lq?pFuecKD#>bC`!IGiOr7PuYkkgG`EX3WvSxBN@SCb?E zl_8zIpLQ*o#=VgsbV{z@H>FFBnwa}5tr`=XCXKN2Z=du!OKj=FW-s_rI0Cgme7pj) zRdThqCm2MWhMeM~>7sj6MTsN<|K$^EAQD!tWGE&moCx@=wa(B)pXZ}m(-pXTTq4NA z8*g1=2@nM$521BHEJGCrG2h{5}9-Rof*B4EDf{?FXl<A+l`rM|C(Rit6jBr%m15Z9B2;qT5q$qzKIP4lwhqDS21HDQ z7ALxOGxHU&?uTlHpL}``anF0N70$?oU5lL_+5=f(V>d9dC^bW{;Y3h!Wh7vaYV0`l za!c?W$G5_S*9?rmC}pf(f%8bewx?EOEB(N^*gY>>0DV==I#P3 z<|)?>{6(m_a+b^t5K4}FlZ_r5Pzt|Y>Hl3MqpXY#n#fhUJ{wLxpX*$xU75hK1|OGZ zYHAL6*Ia}cW<)}+Q3QSN#ELY^d@)xK%33ux{woBeQ#Cd^AdO;OExOm--1$k>SDlT{ zyHisV$l@xTc3&?Q71_CN8c&vyZZ0O2rrf3e&Bb@}X+rq^b5-W|Tm7+lz56+GdnvwY z>K^Pxk}jN(4AH^D2+|XBVOw1uf8fy;ivQQ4n)SVoctHegS}|VNBWY|b{yx&pl!^WM zlD@x)XPcCrkG~?YiSHo%Z)r8=qZAyJ1}h=0Z2CiuDek`N#Fva%xn`e;erS}UFE)8N z2?G0sj4%7&lOI@Z4}{r$oYM3~x;lPj*v?;~1ac$i7<`(2t71=&+#dptGmEj8AH z5AmW0cctF~m6mz^)vL<-x6MuBwr?KxJxwPIkd?b;YU}*cMIzMj|7(IFKy`w(XJ;PZ zVPh)rRyT!^#&DstV9l<-e{VM09*6*PJ(|y14@3S%{R#NuL?+ErGLQ-vS2`gk#pZ2s z`m@m@RVW7$LsyT1Z`x1co7(_dl=WD4z2jpP->-%>~}sGrssN3_kysi!F-&aSBW1oRfiULbrQ(Za`A<`&O!!iMX#dK|BaZAtD}YHSL^GR^>7H4cRkHbnIB#H zoZ=5USZ_gihNYDDQlKMi^wCa&W)su`0$!b%*!I1C@Z%LGRcA z^ll`S#PpZO+fQzY1Db)p868*M&_gHtf#{Ya5D_1SzAp~=0ReFY)~bCE<91NI&4f`M zX+*g4!omy*HlQvDUZX@i=N&x_p#^dR&`t1btmit~B}46z&YrVmEcl_P0dLUU{X-e* zh{G^LG0QrN?8NQq-0vih%&E-r&47noj1r|`GU}stux%=3{Ea~*f>Zfh&a#;+ z>TL(gi|y-^p&$omj;Aa8)tY#e0fP($+wYvBMcBVupp17>{@)4)FCr@H z;O6Gm>{h#Hmu-izu}0G9tcCn7m^#f!mOp<2L{Wlqx!-AA)*%V$_!(hzD=6#Sc54hh z9>gX?OWzZvnr=vVy1WPqB9f)?0oAw!NBv~P&=qB)p-KLN`O?qvA08k3qiK-{WLpH^ zZ!m`%V)f~eJaBKpW~7egqfC}-Wzk5X$I-HiUgCPfLw^sgnHH4!Ms z`g&d0a&;IyLHJ8v5V_BF@7OK?55&*!xII(=?DIbWaOPvZqv?k@#sJ)~zJ1bKi>Q70 z3|QsygYhkd@9jmy{_-r-+id8x+wI{f$|Jo~u|^;_%CHC!Yj!s1eYvaPCL^*97PU067B1USJCitznNdGArChZu_~C_>s(78pQCEfj~XhHixTC zqZ@Cy76PQ&zh3NZZ138s`RbrARGsuwBXUbd%oA1kLGght|A~z_jXfrGI64sEIE5d{F^1i zr1Cq6Bq{9QsGL%3e17^9V>*~?BR5K}Eq`@qGPx&`#N+EbS**=Vp?rfK{bTZ-Iu*Kal%T^$dWG{^hw8X~J%~3JW#ge)v7QnDl?gNBPLn2V7#zkreOi8^`{M zvu=>kpxEzxm|vX?xF*^!V|8`4bAevS4=bD1CdUmIVOh- zb$xwA5ZF7R{QHoT$Oj517uG;{38`E2R58D&lo|CxH599o-e5FB*y%EZjDr~izu{_t za_bgpmW|+(kfbbV|11H@z|6zrMlYnOjmA;cWp|AFs-Gd9D797!Wr0nVqi=~qf;G`o ztmbQSjHvL|4}zsR04II3Dh*RtEQEAIXypGSyBGuQeJ* zH~aQ7qK11Ju8PW99D#nsKSJbmD%uA0-h6}BmhT)iTCd-{!7~o8l0M(IvYadxweJ6h zOF8NyWTP6<)vzlvo6#;s$m-s5eo!{b-6M6pSRac-;V$0&0)^}ABPqocD?WFF*h3&0 z0HaCfwACGvxIN!K8Lw9@0jT!0fXkhHaH0 zLfO641Ojezn}pXA@1*H`q#Nq6y81T5ZQ;);i*~-@-kz9(JKbxcyPPT&E-b~=T0D{F zb`JjR?aIabBPYdN3RS+UWrjRbhb*=B!M z$O|!xxlG_NP|SK4;l7jR2HIUH%P4cnUgo*@`4+=?7ea!xhx+41by zOkG|^ZPZF5dsvG-nX2$ImiipZJ@nP|C*idnE~HwgGYIe1=2bj>ZOPJEyPa?#lV%lp_p0qDMhIUIr}FG9?y1s(pH?4*I%T|1>`Hj?Su~pJ{^W-BMa(vP@%Iqr zh5lUF-!bs6=yebiTSkb5y|Vp;&*F4*gE5q7YkPyobS5*SB=$H!gj)}Y-@LDIZskb6 z((`X#&KTs`t+arKQU$ASls0<)XjPjX$>>~Dj_k3j5I1;Rd0a3BwnxEsneK0K@~>63 zhcC#(y&69$(twjZLM-5TQd=qq)9f-Z!-ztxtD>xV|@Qb7jRY_c6j=VA<^*eDqv?`v&{9 zjWq2)M1MDv&G`Vb77xf6MbTk>29D2FEJf-?X8sg=V!1#CD5?G6>ZbkY3yx~8ywOal zp7mnoaN6W1$qz#I2gmL^g%b+dtE-w4FKsZHHKY18z6jY~D6P6Q-vMwa1yfL0WTfm+&k{MI{%p(M)r zKNg*}E51cN)Q*Hj8YS~t;*S@JKX}{rf!ok?(ZOhsX`O6vu}b&7vjDw*x`;iQX>O>U zf9frbx4I_t-Lo!9WR=uxcVa^)kgZ7!4e*ob@yXMcg((!V-ffM_uDzR6=p7-<;C8y& zWh0$_EH~+oK?2R!+LgiOg)K%=ONM~3iE(4kj()w>D+J$tQ4>~D;=wPD6+WN~PVVgG zD)(u7&@HDLPWN`~<`_&+fFTm~{6i8PrppgBKULh<@`j6b4uEn9E}o4+Kx&$rCTXiU*im}#{86{kK!F~OQuSZwF^CF)lFl-Tf7$#Z_gA%Bt9oh$f4+hiYWg>}APxsLNveB?i zI$_i@>$W|x1olpSl}!nT|K;oHX^-yuEGEF#iKpPM~0bi9>3o~K0l zkC5&SB*yL8mN5`a*=6Omo&b#Ja6XuGy6XMOw-u@M;kV!{S?%7dX5vgHPJ_T? z^>V7w=@Mb5{mBA5664SO*0bW@UeQkyz3|#6H()}P4aCeRD`GL*L%I8_BdmER=0!-} zg7)&h4fLw+&ECCh)Tw|ftGkE952XlNKZiz}$-JB-e!Jh@2^G^v8w0xprdnVhF;6ap=jZ z*KW(C#&|l#kp4-;^>CIyf~(?Srfg>|lv0Bh`vu#qV2}xL(t0PIZuB%an4HF_@FWyp zYz%X-mHB*;?dEOmSPW5Rjc`!-$d8!rJB9se%$D>az-xb$r`2A73{Yi_IzvwX%1{Zq-h+r%v%p68vPL)h?ciTQ^CWpwo`;-$wIM_GxVh1bi2^ zlkTO6At6;d2!|yCYRiIv2ZR9`$mUby)l}_@r_~j=-}7uwdb$}qcA9T#l;6T)RCsU9 zUd0?-o2H?*`QW>G(QC5ZiF&7ue$`xWLytEP52XDr1~qRE3}u_( zI(y@(>2UJZSH^x9DO_M!+Z!rD%YkXu5*&0|$F3j%SewW7lAECGArUATm2mkFz;84W zua1|5Wx78gEtn1xTs9>pCV#iGSg2#^Xd5OjG_(ehvI13t4MqL;ZVFCI=kHPAwk>Smpw zK!RW_)|(EB+BH9UuAFy&CwHgSsmad;gSUlOv8Y5;%fjm4x!(u}1hUxj5FDzM%lTvW z48J)&t&nuw5>jn>7lE%QcDE~bzCGfTJCX%iX{NLMpBKP(7uYM%)?nhy2wpVn)|0uW zMv=xaNOas!9>6L(cJYTJRfg@bAQ4d!67tzrzr);eDGs4W5CU5Af@^hAE2+dHMqHuw zx&+p`gR^FLiB7H5$$Ycdd5z7&q_WheomQm@3dpYYk#C{a&b;^Pi1asyF45C~97m3{ zrw9H|0>T}>&f#H}t~Gl(SusvwUEJvihEgR|y9;#zr&U>)-)$iQw{S_AW>I;0#3{nH zqNyx11@{#0hQlnQBIk3HOsaP?C7LH+fJ^|G5dUBz$IJ+B^Z_8yRm%k2?Qw`%`A^Mw zK4()zHR=NO6DA4lD;62 z!F12*2z;9@@(UO5d*AbBFQp&+>g`U3Tl2BvPd@wm?cuFnO!7O^ddn$aEwy}XySl~& zPcXQj(%n7D&cD7*ag}p6R=kcy9vfms-5OpdMMV$>8d)Woug3a>BoAr`^q3m_fd~dy zh(0_jr8V!Q!<|&yHXCj|+?GAmIBr!LU=fus62+2HP>gK$$5vNKZRU=9h#xxw`ZS{9 zz7lQ*>W^?=+LC$P1oM?QT}wF#TsxgE1BR&r@I?6 z&xX(45oOJ11KVc9KkYbsQlHJnsJJt(84X&z=ik1RJ$@yiOcV3ll93BLGq(B;?_URI zr6omXkXqF_F{Bw_Sy4}k2WraSl)B&v)E7u!+v>T&bmD`h=!*VWOuT-i?=?GFZuW{@ z@x6}#NP%Ndu~wCkwiOB{rmqzM5N!WCI8@Ube`dB5a_+ zDbuMfZA<1cACHNR1$5Ki(b3U3Cezzg{zzhX*110A#fS!u0ySlpYRvO(nsx7DH;dObvL7Eu&&x5Wn zvXJB8P?|8IKbF|duO`3aMM`NiH2>a|#u3+2sKYm|D0H<_8|$rxR6$bxqg$W>f_?$S zvJe8G?aojvgG(=ej@AcmyJ#9|@V6g7e)vA!?o=O_0J>CPT7ktxE=X6v?W#S@#2lk= zvI-By`O>#v~`29U%WY(gF!2`QgL&#%jKkcr-2f4DgaL9o=T; zc#d4}pD%wu=M=uk#E!k%E#4klZpPZ=0;F&eDWtE|V~YlM5$ek#zYS>;xbdG4jh(bu z6?XvC>r;cX#WJu03|8Gb=p!(!!hKCR703$A7x09eydwjWYZOjLRLnLSs;Am{eRZTZJ>}Cy=Iq9^ z-+BA8+p%RaI3VefPEC@t^#5BNKqd1*GqDsgAGsayKL8wvTr)^>DEI zm=J}KLJahR{OgTTq7784oa4^uR=j`!k90C_ld$P3yy%1Nt*zk1#2M4X;E<44BqWv_ z>+7f&M+(Bfic^gSWi5ns=) zbZayR=Jp};;!!FmJ6^xi{w<0>kl6WrG-rvxGdjJvXqs1l&BivI4)#gGAmv-+HywzB zh>D8V-rwH(looyi%ma&8e0Ix+o*Zd0YMe4H9azfyzCRd9d|gC~5g3#o^nb2qtT4P@ z*R>c+4wBxyGZ{=6cK7mv(>+4Cu4LbxoSYonpDG$vn|guwwq8JHb!p3`&{nUu#2P8z zfwTH|X8MUVIb_>owo@nI+>DParkQ;JWc*%U-kA<~=@IjBSM(5};xS@h19NM?^Q#3r zju&$TD#J_k-3vRcOZB71Ge0tL(PMnjaP}$8P`A!4v(kIgoYAxSDYkIsY0FY1z*exbcck9@aQe2T>Q<@~_C6!#de4od&^M)n9KtJ^ z0U)Km^yPN!4S)CEoCEHa7OtoTT<=BQS|@7WiN~ltU;pfjK{!#ptUUJY+?Ao{@wr$; z`0bDfX_N&%vEDxgs@{{ofne_H?S;$MXYqFT^!%7BpX|b8HuS|R+z6;o%qjmQ^V;gu z|x8yN*z{rn^UmcEU2e<$Rw{#O!%R9?rt>VCEE=V{B^vZJe%+&^kjY84*tj_7Ep^0Sve7g$ zcR+paCc@>lT@=u+wJrJmt&dzzviz94+H#svEz|NcWV0^~EW-4ohauv09LgcrneC{|BTVQ8hOLsk9_KvLcLx*V zorZ+Mt%iCT$rI;CMf{K~A%X8$9Um(ZKxf2YgUt*}EYjTcOW?xl;z)FHH)nW#CZSl( zh*MAT^z>vhn*R9gQ*0ET2`u;&Z~~4;^-_3Q+W>tQ=(|9?9>zU}f@uYFMM_x$uA_H>h_SL0n@pj_~g0AWw*yEt2maL_v z#Rvul=J~|IX09?Akf3!R1kFcMO-OuAVK%n5q=QlMrz0rET84vAaFgCx#JJ}FlM)Qf zXRs)9PLh~nPyHZAJ_HF?k!UQiy#M7X_E8YeH|X5*#n>uhPE|YHoRJe*otJoy?w-@a zL~Ktoo%=Y}2Q#?O>|5bS7541GtR!A8(xCor$&Vyb((el2ep~!Z%4fX_$N()jPVa8Y zr|*0LR#lJWcVD7YGG8rcce{Z#@kgu53)XSVvfSm~)%?q+q)^SPL#*x5CtXraAdb*L_`KLy6cjQntQDujq2who4(&|} z?;CsXCvMYRq?>yN%>p$hmxWvfYB(fJKgq(g(<9 z3qaR0ZBN8d2{n4_Z$pr)aJ`%R5c z6`v7+z5!oH1TL;_$pF;2w#cPMIK>RHjM_b`GEpLjwGKG*tluKE5K6xhewwdGs(I@O zoA4AM$8=FSs##P+#|=-LQ-$Xho=5slZ2+N?yvIa3MM3F;a}bB0tujQFkQU1)A}8pn zH1MNuOq?MFcYk+y{U&bAY3H?{m@S!cuHuqfg?4q?bpkv2RJne0m>Vz%T(l}{P9P#C zPEJS%GwL_FOZ*^UYbj94>X`?y9EfRLK0Rb>Vu z?3DTR=~G2W1WEFP^pEB9LzXf%F^4mg%gv;uef^3G=~}xv3HDW-UtKA@HC#zC;_rV+ zc_P=ZXGOK%<9t7;0LcVoF)@*Wy=RX_y=T=zw=LkmdE2K!syK`n4Ah-Z5DwgAzgF=(%@UU56RPsTy+1#($T$}=*NOApdlni^pFYIT z627V&b$3@Tw_k%ozz_C)(6!E`2rfl`{uS@o3gg~Fn18m*!*P2+`uk;2S6#7BXZmv0 zx^3Gi&!cSG_Fb!qtNWyw4?^+9DpbvPH-Qq7JeaaWH}s^>J&6F*1$I>h3;7}>O6rCd zXMgi+%2T;ua~>R;=|iT01ymsfGt|&-fQ|7NOiV1))oF@*-#d;ZzVG=9KoCW)W{v%e zcHmZ9GrT{pLo1B0C#@E5-X7ThQ4n>??OQ)-$wE~Y6InwLM~?)oMT_884l`fKBb_@mXg`=*o)xz#A8$Yvd1!>s1tUER!?8Q-2L$m z0@_*0V)@!5nT5q@>U={yO&gD42E6LM5Nt0Sh0)#fF~`Ig)erS8@^Xgs-pIU(#lMTLvrAQZ8SC?emo(qIj$c(!TPoH% zEKG)gT46ls*H{P6E7nxm3|TM_`gij{J`clmu~b>t%gCF?&dpfP2fXZDv0x&kAiB4c z!$d|2Dn+x52Pa!*-w9bvr|nchIQ1$oG9G}i*#YM%0>G@{x))lm^_R^Jd~XZTaByrK zyLt%d>4Lr+HU@aW+K*m;`n_ zr8=Jl2=IZAHY2Hmy%Ag}p#Ow!OMw>-Qk%EIpcI^eD%upRYid~+xvu5B>l)~U!pS(v zYt-~s5z1S>EfS6rxS^PzhI_?OxBNb+yHhjN$PRsSa4!WbW-}SHB|Re4 z7HRF;drW|E^V(n3pDQ{7T#}*978Iwvh0dYFs2UdylS zz%0X`zb?l)+#FM`5_jd4jx7dBW`f7 z`1M>JC$895!kMK9CHIyg!`UW(4GD-6K>kK=r37|Atss^~_&tj2u|K<(pLB)<+|tuL zpeHbXDql5~+ijUHo@EZtqE(gq1%K7FoFlOR>X~q)@kjzmv#D6`)@OU? z3Ogy(Kh}_;r#l%z*i~%~pG>#A*85iTXVc9(B*XQ%so{CXAk+jt`hR0(dYW1`{`l47 z@hllEnW=r=^>6hcnQQ&0cVb16e<TTl1o55d%e`?rkRENGSYEle(|)bTY=-^R`|VWWS%&)qg-(Rp6t3I?(quMtZd3h zzAw=&@uU+61}kc$(at)xwg`qmZ2$oxeX-g(FrUm2^19k_I+zx{AExjkvd-Ob*&MKMS;FMTR{s@Z;ih%faOWl^<+7MtB07Jv^GnASr_F{*T(*r z(I-F83nj7Yy8xS9B9uBW^97S|!A8fe4^!`sEscyy$-tkxkU@aFqv7 zCM#QkW7rC_5$Y*gNfVSL?^2w!Ogi4Z*JZn;?Q@p>KC1x`WFSnj42fi%h9FRMbTo77 zOE8L+0ro?Xh;sA0d|LK92F2r0pGMu-zf)*u&sqm}EP{k6UVKraT%K-^z3Iq^U&ej~ z?9;kc!y=$&KPP|6n0MKq)Nb@R54ZV2AbS5|*Z zh#CwJ{$Wu?g>{l()mmnG`Fj9hcy(zX0B5+A#(+TwzQPO8$f&kk0f%#8UR#3?Snx&~ zli6B3=43UklsWq7r@#ITkV4Z*{8>3SPIgJ*M>9*bkt*U*3EX)JVEyCqxpM{_l-u_o zs?5k4l+xxK#lL*1P%&K5EbC>%c)4@Ic66A9DedvAqoOL$iCj}k-vlP2`7;~Sp;6&&JLzCLD`m$@g{3;K z`yn7n_}w2)YkDIo*q%m&PdHrci?xnmMbp#`@l9JEAo9QuP)RdDLKr*rIM0DZ1nsqKR$;8rGT;luJTNvx5^BrPByvZ+6=$cr%A{I4Z=hLis$!y!^ z>t!!2e2kX&keaB$qatB0S6}>1J&}4$qkgUb0n4N zsfW~#G3bRXJn-~DC?Q<0k52P4v^1(5Zv|Vt07*Aix0!029fMlGt>tL?aprW9aJQ;< z88@Pr$aqBlC!YewyJO}R?{kHBH}3A!i}kAJ;p93^=Q&U#Jg_YUJ4Q@2X!1vxp{}xW zmR$%YxzF}w!7IC_Q$%thXXStIwS<4!JrFS9{4F&7F|q7h-=N<2^Bj+-g^LUv)xtcj z*QE`8gH3Fce4EBZ;_;^bSXCj{_4c7^7*y7BS4a}R$a{BnBo~TF{)yAicW=&VM=_bp z)%sLXd{jP-0+q7X0J(q^r~T${7A5J;QSFMh)i4lAS@fR&j6a%ROe>s#d@D*X7ynco z=S35Kw`dO@U-wA7`1%R$7%_%CL2%_~YNG}q(&X&HA^G5%gufSc*^eXnzQ_xdUxh?= zJ!BM={?m!g{y>HZ;MQpqJ;8k!JsP%U*xY2+X}}f>S2fB;7zCN(uRbHYpQ zESUl(8sS{d`{OR^Su&K#DaI?>gI&uZ*=jREhr)tECam>V0r3+NS~r1gguAuB9VQ4v ziHtjBAQTEfN=?abmZ|_wb3i~y6LNcU2HqO2xfQ!Q7H;V|f8Mw`5SsJCrhRw#>nhh$ z_51HHQ(qzqr^e@Xj`Xrz@!7Q1Y)Z5%eqeLante9?ap+UJLdifK=j-yI{T@8pyCI@D z(nmbwv$V5#;>2b+&a)<|Emmm;1kk?R*kw$t9_I7aLKhD0JMa8zJ{FDQB)m9m3D~e3 zw+LdM5a3jlYKdk1eSuj*hQ>8(%kb@_>uil$Y|64w6uG4AyBkiBIo6jV8#G3{vImx_ z0{#}i)|QsXyUQ%#tlh`AQjvc%C6PeDsW1^Jzuk!g#>RRQ?Ha94FgBJlPsBSt&Nq`D zzyYoitp=0#lAJF6_!7t{RO<%3*0Y>1?x(^sO{q85e;pqVOuvhkFV~2l9=N5b8DF7M z6R%0a>?nPyI(c3A8HGC9M#!)H@Bn{s)ZYS;irVozP#P*d&dofpk00;mBS;w<5D+Wj z%j2QZM-sB?%CWJr-_9;wo<3h4Qm+86K4;);C#z14Jn9EzY8a`9#u~d7%(fecjnY5X z3oT0OZi$UG2MkPCrBm6&RZ4EfLu(ryC^jvQ*=NX&SNUemA-I6|`j0YGy!XknXaP1& zZxXjDs$>Yd(L}C-%V?@_E%@rp^gKu0DA|@@Cj=Xz3B{8&DK9vfccsp__bh64_4CU) z=l&S_kIMht{>s+D!HtaO2hfDqK1K^NgIi049RSu@hIJk*+Y1U|Eg0Q`mY2UU2WA7QO znHDaij-U}k5<{sGlt%U&CO9lIoyqIN<4s8<*_4wxeH(JKOwH2W`lN&lj832Okyf;o7_Jgv@9mXQnQuuMK05=oZYXOFvH9cb?V{r z9~)B!(v6l>casq~xea3oNbXs{*-af2^!x$tT@jfOY`I^wK+*a=S!3YqVGJl=X)uUb z6s*B?K~W%@CsKe5m;$7J)6oG%3p%9<=Y>He@XMRxe&g0xukf}q6xCI2~@G5FzoyOqezTZX+( zX?`Wc4;Vt!VQ|MeNC5k;u-13hoq1r`?6f^(1dKNTq48$>xcS~K1W~j+LcpbM-rdaL zc+-m?!!WbLNkw2@R7+3SYQq2W`D8USj_KhOsKUYi^p9CDs%eV_0lQ}8qI-#R0r`o` z^OwyI1hgxEi`+!Or|L?h zl~TRyy`;UWJG{Z4UPdq(Y5Zp;#HF8v(0%o>Y9DytVek#$x!^x9UNk3D_M)p=g%V?* zi95Lydh<{;(q|OLFw8I{x^O)Rbi$D1PX!`1?thVm!hwf4uDFxx71xYDEq$Q-gySp1vLb?G6B|ONQ$_N=Fh7wiA7&Xblx=lnqmL-ryC|Ux4+FkzGywf*!9O+M@qkWxa zcN{ad&%2EPq)h^7ZTSHsrLxQnb^bQrN0-g?_arsO@=*G;6pwL-pER|Nf zm?j7kg`uRoEUcyFFFRL#Iiis!FV!i9_Fq(c)B?H=IAWlL07e%Ez{#T-(#)h?S26kB zT9a>~!7JnA-uaT$zXq}S04@HOaz3{>xGAq6TG#l4?kyuDXR%}?3zeytg-J~Y?xeVh zsL>g?B)`9*s_@sKO${25+fjJmmN}HL`>GW=RHpr`w5oIkJ{BnPikCSu$!&m$*^NT! zMYSTj?)K_qxZdX9WUGZb=f#aMqJ39LLfK}BM4|#ppZ`HZj6oF*d)Z9G^{EgNP}U0m z0_|E!5SAZGDfv@(fliz&i}C_4t4OW1O(ayNp{LBa|KD8o;ab1Hzdx)wi7n%yeK^WQ z)yw;&tLp<18{Z~N(w@pR|7aJ%2|=(|aO)sR!G3GkCqv^xd6VoP=5IwT%3cd%KQkmi zdxQG`Iaq3W%|N_$g^F5FY4H76#ovJTCHw(OV*fp_duss_#488@GJgY7QJH;E zj}aik(l%+8EPJ#vs!n6ff>-44<{hTwY$^ z+Y$t*>HO78jTPXsk@mNLQFYzI?mKVD=%)^6tKSk*`dpoFeJN)o4er4~4Lpws|!?4iN>XW-ix<*H4I44KD zHf@?jf)DDZ^6YCrC$i-H43dMa_i0cmDoO|96^h>5$-~7u%5-2$Z1x5rH3ryJ{N^qM-Vcb2%q(bGwHs&ua1i$e4qm}DMZUVJY?{0O^eY1PAig(k!IK)6bl|gr+)+eN zgGK>r%p{-gR}F*Ff^UXZ~%7gJ_d(&@@DyMW#t4m9JpD5x6 z5TJBQ2*Bf=1PCoe4X}RF8Hrf4y|d5PCUK~BRNlzjiita3jKUf~&R~sYx7LLPC8qAs zeHl0`R%L&EVjQQ~H6-*n|BjzO1w6?_+)T-bPpX9)oE4KSole;LDD4IJ>wg!jjLGr-l+ouN7!kWBY;r0jyruq09$Gp8ZPePLjl#Rw#GV z?~{yE+B;t#Mn90ZO2YjYo>Q2am@xgoji}8|jCqLw56=J$qT-`s@OTx#eJLp=<v7K2ciM`K;MFpSPv{u!#}uv!`#!#m&tP*&IsqUDRW9OHNLn z_`zduKn}6BwS`heuK~-Ayuju(T`AYX_ZmVSx^W7o=>C6*p0@+t^$QS}KPyXpd@2f1 z^={6#)zsC4b6_y?lJfHMI#6C9_yJyz^a@BS!CeAL;q|Nv2~#w|T1U{mLrC%W@GGpX z?H=;HsDOVGAmE2TRaHGR0QNy@38D0H6XN7NUj$}AVK4ZcaYbLPx}L!CFh) z#tSvMAz)b?eSzuKB>>YEou0z~E%+O4DRCp$C+i#lZ@zxXUZ%_mQ?eB^h}V=?UyTwR9J!vyB}vy)%b)P`Ht8iUU#tHcSt18Jy=SmM|R(}8vf;0 z4(7z6Cyf4=_VX?R=to{kOsP=AIV>VV))Y2Ar?JZ{mFET}k6r-U0vu+=XU{MrdS5OS zhv(_Z1d+5;wM9Xhp(Tz%e{6+ATr;%rc&3Qq4Ib|tr-=ftrB}wK{&C7O^e#oAG z4buq7Z_ccaw$)DDhm<+;FyRC5;dJDRJdlV!UT;Z^%KxFCw~t0Y;hupbfP_`NooYnE zZg>s$@v&)7&4=iH5RtcC00?pi&KWw3cHQ{%Ww0k9dO%MQdB_cl5-3yj#xFtd*|QZJ zlgaGgiY6}V7B|`m)6L7-Ny5|i#1erqw4;YM$j(3B_k-QiT+7)oL%5^NrOl#_wPooOg_En z>%t`eZp+~^-WrYfr3}N5&;QM@_Iih^2H<$KevM``;JFEOsRFbRyWJ(GZ~7p@pOS*V#-=Y3oChMqn*VRBXyN`UlKLILHo zgS)%?41lY*zsDu@>{yKF`cKYw(z+gWu*{l?Cj9WZ#KEqwMAm%Qf+->@JEgAH){-Yr zi|%vbapP;9qTj{tc7*VP7o~DBpjBID$)nS9m zW@tU0IJ#$*FXWXW#W`mb^}-}(lAkmQ^%i=a|3HayN>zB2Ul-556N8bouw)~GOmYZDsbWmuCv)>74hM^(qc_4ZBs4ctS&v*D0ocFq$5Cb-Z%Z8|g zey5o&2$L$?DF*6UaB%+eDD!7|;v=N9eTbz=`(UQtCMNTuKQy+rjY8{%Y^1&koNRqd z!8f~GD$IL$`1bU4I;R7;&s*;uc>Z3a#ldTe)2oo)e20YD5es3mxCI81VgAHs4sEYM zvpac~G$UGmF@U>8;nz05K{3N$ulx zwGvVd0L+1M914E3C%#lF(EhkHLZNx?5)xlcwX{-3HBh9!ecLkt;sFYJ7=vm2F=b?P zw3YrD(^ro{sxt@97D33DaHOR(Lfp4m*&97|idLYgiI`tgtr zq4xpEhBuEJ?7}|>?KuBB)td3Tl|R$EBkAJbM($gQB{kKw{9Pz@WYjgMn!q7X`c+P< zOdCKsf-|R2SjdO(%7Bn=v($9Y<5i$h`DeT(^XD0s=87C#RhCb)(fa*;svb z4GjZR(?n7tBD!F@GNeb#sS^@m0&0vxuc9}y-E-NDS$R3SH889izSdgZmHF%DD@61? zD_P$kFq}!Y@&E?e);9!Ig}%=OAqEsJJF@b-V|2`nwE`LM@pwx9;tTHW$xM-rQLVG@ z3E`0QXGrPrJhQeyqDFHmb_f4Nag0h)wCUy1r{_GLNC*6WJ?}ynDFc3y5X%$m?#r5> z;Uhaal%3~|rE7v4 z$f%&Bp=;YPokWu42uP!hGS~lbshBMnDH5;WDODoTENfX(5)c~PI*E+#=_hFG@fj*< zw~^fa-3@|4*z#}j=>9d28|qzA8-WmyC#je2J*O1=juK0HdZD$BCtZ$4%T(Fre+kPA zOQ5j6K*6Eda|BogHjoAl-Tk_rr+|Ww=5oTuUZ!R~c6j*XY-y!DsDkFo7>D0hvVOl= zBv3`ZSOEVJYfACKe>k(Hs|%khCf3I{=-1U>XD+U6$3WWkAqg75|Z zQ?4JK8A1Mz>jrSwJ&Uz!PxzwJgs$+^+Cq9*fR75GL3ca?^3CAKOjw_YKnVrqq(<|< zDqp>3Xvi=P` zZ8w+5V{yykrlf`fdI5RMB>ce=vSU8o;r0xwnGG5t^yr@bN}nLk8%rua;7{dB-~pTc zGdIeBa_ZtcLPy93F;Ta=P&2+C$Z8b|)ZWaH1mpTjOv2&K3<5?#q#}bmXdzjWzBM~~ z!p%9bKkK;Bzoh#Z!*1{7|C2Y-0ygjh6{ib$) z!1tWGc>YRNQT*I;SzvzT+1@oYk771TEa9yfg~Rf*%O)-lQSulUFWScgHCl4mlI?8w zhamlf7|a%1%(6A+dbpAIpHYn$c9l&~si^*dj$I#uvb5>90Rsdcn%B<=o*U*@syq|? z-&q~6buL;z0p!=X*w@FvTu&Z}cFYeLt!CdQO|HuggXLs7DqpV;p3~6q zhr-X@9r-lUT{1rM$=uDqeOR4QWNWXmLGgQom_3yf~6Nnu#dUP=b$tS zVlf%rvFQt`kZ35cQZ77UHB|{J&+G|LVOEz2yga8jo^bKN@&-y~vmcCOW$sX~o0`ov z=p=r*8ezB&FDpwfl7I*+?DhM2V>Wx}xCOHR%CZjT4=(@m=9V7w>{|vT!b!dDE29#R zkC0k#(uDosrUAW$YP%D5GYoo75{vlY362#v;e=_cNk1~bRz26dD|-@@mqBh&6JIAo zK zK}8iHA9ahSgKuw`@+$+fV67yqM|?MDPBqB_;eOM4H9k0>()?&%&DX$}LiIK<3Hn5R zh-&N*U&|psvK5|3gz#|NaA2fd+h7!p}M%6QJ!zi0Pajo7O^p}?*>DO04{<=xa1a+08)yKHxUQbjW-qJF-Cb$W4|s^bw7b7? zmP%lPl6`K7t9LyNnB*}5eL|Vw&PT%yTkD{FasBa;oMO3fKXpU>&yqd+i1v{!hhMg< zFdWmGY!#XQzQ7hrMB;dbIFH!fHk=`t@(xkk_5HR8E&+P=f#~H-ww}{k*I1-uD~8}Z zcv@-yz=&;L+j$QUi{%O#Ss@S&F*X7`bn9@kNVc-7#Ew~^A=lK)szBOIKI+Ym0*yi>1s?hN*Q^fw@YypX zWQ6JI+2!@U@Yr&W?}IEgL`-HSC1u#B%|7i*BfZc%&&z{N(A~DFQQYY|ZR_rhrOQ*6 zuG0)#s`q^qG_xl4{S}L-72=mzllCb9V=Gl_P#69+^Ov9RGPGTJ5-A{kE$wr5 z>#L3w^jJl=_nyVK1jfkI@L5@a14|DQUr<`&LI8$n2wsF9_UuzCe=V>&q4$-LkN`Qs z`qtzluyGj!_J!SvK$i1;lJ62&?@HYr-Cur(emhR}=eFgEcN*GV-PzILV&UrAuvxyx zm-gJ9k1j2RMND3Fz(^&^2E`OpwP-fJyuGK{r#II4$J+^cgI=&25wzG8`DRl={DH(04XVen{l{{$!mMSF3s^li#4BxJ##bz0vwU4_gh- z4cDFzR(h0gBZyDU6M1-_DaZrM6&8BfDu>SFe61r15II?$rFig@lU$F7cqXVJ-8aYK zW0ZdsR)W0sAYWv#oMk<{YF*|nF$s(tdDKISO8BUzmW2Q1zb~CEn`-q#R3G$VRQ+aF zR#rIf?(RYXGV#>(3j-G?@A>Xr^)Xn((;jS4>(cdr-?)lpj&= zHiH(Sl(_g`lhN}jh;F{dVQd}hoC=(_w9RfRHu60Rj6FEi?z44Gj^--#f4TlP**z9(yyZh^K%AEF`N+i zYt_oWf5j|dL_8*!w@p{*+YFjseOJ1{<_Q$4s%&w{28RHo}tHcilK_dtIOi@Z8Rmv2=P8AjtQVj21=srt5 zrUt{zqg-bnYnB2bZby&DcZ5+fG53FFIp9>YIf$P6g)d`CI84|a)+I=}xe8tQ!9qxF zc@M^^_M-JdG9C~K^2)8?ZyR0QcCat7WK@LHZ4)_J9 zsE`FGdDo;Ydfy-7m>ejnaRY_kbJlJI-d*E6leM<{3 z;wjKQ%v5HKn>#=DlVkO{JMPwz$}{o<8sbynVk0fqYXWNIZ{guyDZ1r0L`+DN6l{)P zwhgTI!Y(6&cz7PyVj(9Up2WAjZ~vf0<52y}fEwY`qvoxYxDd$vgrnYWB(Nse-(#Z3 z47zSlEwpdE9OA}nh7{GP(|}H zG+^KO^3^LzDsPwHOw8W8n9Yc31CUc9FJl<2Egp4jsaCpuzE++C=kE&?6uI|q_-ZpE zBcn$)IK(_~Zm5BTg6^r|9VWV{vlAg=C~3eVPV}2b_7Pk*r${O~ox6Tt;&3tf6?q_D z`EnoU*Ka8AOvj|Q4xNKb9b0DF&QeFqe13(YuyN;ruKU&Xb?+zo|7yhqpq~zS`U6Ba zcC+16RktV$9y)@%3nxBmA1agPDQXSFl!7c|-^PA!>)&Q+0hhXBuUNIHQpi~Os-|+hPH;>+~fk@+S7#1EaRqkvKU1QacE|{Nm z0;EEg*YMbEp@>=h?tjLqY7F7_mppwSrB(jbvv7HK%*0w)ayOLfYVC84vMcSEME`^k zeLOey?zYJ7PWYL0;k>^DOzBLo#=@$j@V+9Hlsst)%Md_*9_loWKhp+ihZHEdg_YXP zP2Tlq|AtMjS%n_?R{~tDD8{cc=Sv$+%#gj23KvytHaIF>Xv{zBS{ZUdzy8&yd2`=L zaIVxaMf8PWlko&WKbVSu0mISN6@}`x zruXOM#`*idnDW_7QJ8|_X})PK93^}2c-#pbcm>H_Rz>tKC3ENT(KYWLe61bd&waF8 zL)60LjOg!M)`EQT#xA|o-z!-PiNx%7ZI45;qeHZq>^b@Qn&30W*VZ<8AkUwH3w}a5 zE~-Jk*)qN%Wx3A=ARLx+3uWD^!>wN!hiWxWSk_1S2kUScZ@sgBY9Lx!%W4-Wrg21R z8JD9;b1ce*e)&M% zqd^$)i-;!xa~@*V(}HnX#p?9FFe+m>-KT4JRzQ@E->uNlnc%zETSJuo8y9w0_*%7?KB_CTSQ4Bf!_252gKJr@+r?N>CHyXa={+pU6t^O4RE4bTP2XW) zUa$9Bo2bZ_zK%kr!@etii}Z%N#8a*d`vIS!S8ldV;SjIshlgX&#e)O z2_I(lT-YHokke8IWp{@cDejlsZo5zG+bbmdRU^oeru%A;qh zKaBjCPyXaC7-LDbKz=2(zWyBm6JWp(ThXVO4Yabfw6%w(d3cB^J35Tg2&2~Nk1oD! z6>(%x3$l$FzuMD4O8k^Oxk9gu-WMNovay``F}prR5OufdOEDLJy`$f!z(S$6oc`rs zAK7lV=oX6kf31YcMp;}t;VSmwi&XdwibR>nr^CzqK(x1)OYQC=gfDKHEFc$t=0_|o zJ*ueK7N>{<(B)5n!)9!X|CIfxF991HsBRPgSdN^yrS((}m^`to!nE(h!I$TtIN)MZ zv0n`RtPUp?(4B_)61uHD7MiGt|3c0nnRM2-|M%U>RznEZ!BWmjqT?3Jjn~mKmK1aW zT#Vfa51sirpn(eX&_~OI8~rn;#yhA&|CW|2eqWvb+xlxvW;f#m-?NWRE9GZuo;yYC z(SSi4+EOWfvN>yx}u=KVxJ=4lsSzS)<)RFF!#1-z-OU|?dvD(v1YFM_%!1@_f z7$0X*S~K)1gVq^#e#{=cGMiS2ol}qQIV8fuXQliQQ(>->cEgMxEWP_xcTz2tzbs>L zp?H&s-{(xCHmzzuX|ZX4t`wr9qXQJq@_h#c%D`7*H{ZwSU&ULjT&6}+zN9Xfj_$|9 zTXi+jTbmZ`>5{G9^A#MKoLF(a+acTx{b|qP^0hHI8c{7=D+Ytvbjbx^XY^E9$X866(Fz1vS^}3}kd>@9UeK_2#SiN2`d_4;#YxvG+r(s+^O zM?(z@j|2Ic44WoQX-i^$g6web;~~q)gH~6e?Qy=au)#*@4o`thh%bNz{|Gw#%C2=$g#2}ZR}0!{&jB%;6*ar zl>g2A>%7cYo^$fq?>n`fg4%7M&VTj)1TGJ*s51!Hq4%-j7o89>GHP3rD+BnNCcXU_ ztxmmho{~=dtMU^QI0}gQEb;#8I?bsI2DQ!)0Lm3-0j4RN`6vyGcJ1ooZadD$gSqPB ze(ywsqOKxC&Pq*&zs3dKkDj=1EXGjB3_1xYWvRy-lfKU!E7#8bgCT(5hDKR&cMn?_2K;^(JJ@ z)bM7#;H8=M#$0#~Q55X;wlFvHTW_^9oCzWx$%6}d`L_q+Ha@^jL8L8zb^tk!z}-Rp zq0!d!|6<4x;6~)C6q4Rv9&Tj{dM_ZKZwstxEHBu&VkrAlJm=iVhbp?W+iBcAe!*oc z%(XGaIQ07cY#x0l>+rSmVl7B;bHyX2=FuBCYLmoQl0dV5ZGWHH_#)J7wqhIGQgbfa zbamD27i?GWMpY>_w8Y~)?DBft=*pb*MKflIPf#>W?})C%iXep_0Vh-D&0kKOxO~iG zZoPT8t9_fBQ(`da$ieL->D#vwLymAavQPrQ_@AkZ+q34sqU~=^bK&hADrbCS0VIr&H!G8axNnO zbuKusuCC-^QUnk}mb;z(LbA!BX2Mut-gKTbT-4mfocL0qPU}90x+9lb?ES* zM{gmu0~E4(s$#|@GO8Wwc^qnQO*8Uk>-jP@d^^$T_f6P zxH=bEHsnFLq4lUl@%khY`(Tdl-7nB5?`2Y371~%^JLU0W(kWZtk60>9-Fp7)GgHyM z-N2kT{$xTFQ@K{7BJ~I8m{OxnEx|(fZjgxpR_ieo!R9J8c`~b0^8y%%0BaU0_51GG zDr-;Tz*e`fOOMN}9ZLkrDM){@zC?ky?7PDGzi)VRBY5Ca>DC)l&0TbDk}7BCR9b`G z{+8L3feBMCdzzqF2Ul`*c`xf9*M&W5t#hmC&Cfy&X;gQlC%+HhDq)M z)2eM>u4qQOEzi5pMM`;QFr{I@Ov|$Sk1n2H{2zon@w+o@X|cv+qM`hmV3`i8CPLNlZcCYl>FUg zz4y(vfILxnml=`gZ6+iT8SDQT;l)*;1cPVuX(Iw-XRdr!W|nhhR@!CS#1k;62O~8_ z0t{krx`PFibjlCNF6iV^jX<1L{N$?u%B#oGM*<)U_5r&ue3#YKRMoC6ak?t2K#HRif ziqo|d)Zx}%X!!G{nnCqD6b1Xc^=ys8IB*aH3V?#RiL?sOOB>*OJ7NXU(g7^wz}oou z_^Pt9w!S`eX=!QphpLhiw>#G^>x6^^J~peYdc{e}6}jd+OrSRfdFd!vG6-a$^Ks-YmZ$ zTvk~h%;%3kz?!iGB}v8P#gb2>RZFt8&%!EWbKbwV9}KNoR$jdeilV`CcVN639ET$; z+7tT6xzk>xP5NYP91GG`Y2JHDz`b5juXWfkg5iUHG#?cDEhq@lz|inpXy{9J_88C} z5)l2ZTrVdu{0)j z`m&~Q++kc88hq`av`^H5eU`SY;g9loUTv|3zdO^UZGDvOJlkn(W z`w$QIc?n=mdJ6yvM=7X3wN&!F+#l28M(v*-Ccob0=9*KUC?zFVA)`$UrgR0QtN;Jp znu4ir5U-2tWdqMDYZ5Qj8G@;WE=z`Sc^U!7Wri|w)REZ=C5LhrhEg%g`#IysQ9-)M zNX;sP;9cNMe|5DM2}?**gPIgq0X#3T zBfebd0i>}IH~{MIdzg@kz<;1>^?vjgKuW^S0tbXK0un0vYz)xl1b1q1(dBZQ>W0)E}*H zg4}IO&>0oU(-rCOtDc*V%P<7o+kFcQ-oWsW+2a?VvqhNVj(!(8nCjP5pcRb1876c4 z!wBa%aUQvGXe8RgxGx9{8rU#};sN4l{Dw&@pW6`?m?-JtRSS@$Y+JoT3|nCN=Lp(H z=0q$h)mF2)BfH0?r8YRP+MF$<&`C=wDmq4bB{v3RxqVuHcg_Kgh~Y@K?9U3&8bqXr zrAn~_dxPhIa-2wd!u`}IF09P(T@u^}9C6O1X>qxpe`PDbS*2&i-HA2Ulu!Jq&s;9^I_ z3~ZlBq^0|>z^B%!^SQsF1HYEl0pJP#ej7m1<_;Xf00Xg@Q7Mk z;S$k(@r;SURW5u81P+*=pPw@UgHnxvUW=b6*n(#h8b1@6HMtg-mX_Mg-kMYx= z1V(?HGp;+>nd#EV6~P~uj!@Wi_PZhf$_E`NOjJaq2Q*Tvyyn2I#c11f{aWwGA0xS4sA%>-8#1<&{G=_`Raf_5snn?U0dT z9wKC`MTx9O=0f+kcZRoxGwpWePo;%z^5sUN4@vV40PGdAWk~Yg`wCkY3hsa6{`~_E^-F`w!1?jz$jAsapdz5x0ROcca7q_Rfu!pmB!AZ?J_UcZ zDU|(X1Dh z3H^vZgI)uEr^1hW_Mg0vZE&$_d{UVBAAYsc_4Ci&->Ys+CjJaGdR)w-mN;!If^H5S zC#!ZOg}|`JJ6Ef*y1Dq_T++IIDtg`h-njagTT<{pT$GP3yX*zLu|MFz+lXbiECz$j=^E-TcdwxeSpeKs&RclQN-0dFvGIP;#1iwj~kR}}%S zzlWhI&*N3GI7J1=t-tDQt0x=9gx%ez!4&~tiGnB2`0OdqNMZQ3j!UM6dXs`<)Hte?8%}E#35pKH#^b8rSFIQ zF?y!mS!r(v2S?APk}jATk$kq!A4^>qM--H`DSZaBE>nd?{BWt>zV|q^h?7tjMpViQ zq(Ws4FnF)fhl2X`ZEFB(fMS+p;$oI`2(AQGR-&Yw$)=a@d@}Bj07Thke#?PABNLms z>is2w`lI)BBNY`>vp>$s&cV3qu81dVe&8KJusx9mgw`NO`uq5Jb-adUGMJ)n31q&? z1qB5fVCr=o4mx@nAjk5of-*NGGIFT5p`ihx`SIa)BEZ=GN$2wk==~|ou94Ob9?jvK z<3=~GiF9~8%+|V=Us3h_utk&#qPHQUe65FeRFy-t&sXudQE%I{T~LrIPyZmojen0@ zF!$>m(Df^Cw?o9*hth;p=_)OxO;dNFc{5tehsEEpUp>kWq4u*o`w>JX(eReZmYkY; z4ee32%sI-15$U7|S?|Oti+nu;eubdjV8TCwvJ5-wx4G9nJYHF`L_5rKA$hfZ_N8V^ zB7U{E13QTwGtyh=bEDQak?Y<07w8L4!9U}kuONznz>Zh z@R;N);C2ciN+9+Ka&fH!XXq^z??>-BzEqGG*PFV zpE^e8{a}(}$CP%zBR;%pEGh5K{Fk9#c(BWNC0#ASJWda2ilA;q97@(yYc6*$SEmLn zV=mTQ35vwUxMCHt2}F#*wCZ@^M8I#4k_tQ9N>X@b*+olxDb1{arqTRcq!`~d)Faa` zF{F1rkSsVec5Ga~eNhlg3yQuHj)sN?Ja@MqAD>`N&>uhsIr1N1v~%zWki2YD6BAXN zz+rR&L$t+#nyBgg^zzvfR z_J;j0Um{p04pDHap7cpDqr4(I5p@Y|iya9Np~0aiq5sD()0a_RqqITNZ2gn_qDZ0g zBtR4lbDGvVIr+vH1$fWuz*%yw%Xic3c>G({iaO8pi|md8o$_STdwG2RL`-3M_4m6r zC)2Q=sQK`4)vUPhj~~1`y1Eumo)|`yZWIa%3fG6stA^m7dounCeh-w1l!xVYSziVG<2&Z!) z+Jt(^yyWYf8OQCD4OgHhB0`;ic5vnj%&|#?goLu2w+^9DYvPXcZ&Q}iBg)sz&^5GoJu`>a6iF0~dnyw1)if9H_=<`4{KP)&0V6R7@ zeNMRre3GrO@6YLM2+J+N;G1a9#cvD2PRlBr${^-VINW~vud8SR%p=%A zGEqYQJZtN5=MHMqq(Z*F-arHx=Z}vrmT_DhtXF9@69WWP^tF4hbf*<*!edLR6bNV?aQk1g1qofR_qwR@?!AUjBFh z{TItqOn5;;LZSvXnAGc7C^r?=vYUy?<}_fQ>lVvrw53t{-r2{&#%f@4BQWViFdl#( z0(KHT*QRcj6$u1jaUQ1a*|PB;yE>5`vD=;#gq~-G;rMw|ZE9+gc{en0$pQ)A4M>lY zgnXOWV?;9O-#*0SMFp&8e(uKJxHy<;q-T+P+e^%*eR47fuj<;v+?Gk zAKENdR2SUmD~>4^xBea7*A1LT5?esNe7|MC6iF(roO-S6t^V-Q!lSz(^gLbVv-O$i zH=Iu0XoR41LTFWy(dK%1s=#i4S<4ck!;^s*U?CcUvZxZMZ*R{*Ca)_5?6@OAb@~qe zX>Q|n^8&Cyf4BuJMFn#Lm4VY57y;2(ALlC-+%LdUIbB5m!?9PWGh z&gU}tJ&)yOFN>A(rdJS92Ju8_Iv#1#o^$X7)aE#&G8-#m zKIvz(vKX}tgS_z9FFypte;O_;H)_FW(ey;N)hhLB(-i&UqEqWY3(l;&70&M=!Q1fi zt-;!NGcy&D1m9WS?$VU5n2d=Buj*`lR|v>?_1068g4cIOV72Y~4=B92CT@XH7_Km? zGyQ#_4k^$kB?4oE{phGDDlo_in6-L`0L$!dpzhw18~ZJW0k#o9w z?J+0KB4({$z1+uaGIyko*G#fISH6G_yZ@g!a!)Xo%R64&4uL|g58 z3n1n9T{3P9LIaWIy7ZkN6ZT3$GKYnM^_b8c9qNuiv2v4QCS~X?HHz7obca#0gp}0I z3?NHCOW5t+$Ke3T&G)#`QjkBU*??612K2i~O^l2n5`nG4R#tn`0Hyl%+)TR}{ENjJ zU=qUt#&!5U6*2)p@rhGfS!q2BfYXYlbOvp7qums>|;jW*r?Bh_~%Q{e6C~zIEtis{^{WY7kYwQAW1HiNq zhF4Jh&{bMtfVX^!i~l(_dcapu`{SHUgIbQd&EYS--L=fi z(R8&u^f|`@M2tT@+!~(pf3Y(b&KdC{I{RLB;fFR0*@g@2L31a5V2s#X zHww&?NkW}LG2H(+1L9mS_?*1%z&98irXg?z9o~W=x9 zD3i?2=mRLCNKfF<>gMKT1sHQ+{xQ=Y0CmE1U=~LHAz&exK20Y0sq494`5Xe~^N2m1 z2wp7*(zV@XWMlyE!f*hzXnACMUT&+-FLa7?-z#=L?@*44EiAwVQywBn1ih+oU!Diz z2==fp6v%^ZBI2j^#VQ!L;bGSD^CQ1~gS}1lCCyO7&DFQaIdX(A$jqRBID3zJ-T|mI>G`x7>2u%o88%?#`Wc z66wm6S5;9c0ug-`u$1_B3Z{Pz&eqtkC4ieO1#$&`%&Dp&P&deBT?5<}yCthP*4J#I zU}iSBMG6F1qZE&M%*G#B2F%~Z50~~9JUQlhpXGvA7Sr&1x(C!^CKr7V8*#X; z?+UdoVp)zx1G-;BEF3)d~cjY)Oy}jGF;A*tV2Pm+lAAt1NAD1Uob(JrgA^`r% z4#q`2>8|snBqVTdEhajIsRj!Kz+vX^L}|f}iX|sUE6~1`3cEQ+!Js}%^S&Sf?xCt* z6v5^d_fz{Lz{@jTZoOO8Y09EgW!i)JtvJo?H=lv#A4AEO{4BOc{uE1~GB?UW*8ocPhy{iOrh}We08D?DyXCU( z(q&SQp{64Tpxq)9sF$dOigvggoi1*SjYIgLfuU_lh*W4K(Q!4pQgwo|T7v2XgK8)$=l`1sKU*iY4kusj6$9HjPq5#$T1-VmVacu2%fiRE(XiT%zDH8bglI{||i~D&${&KmNa^}oA``UZ|O7e6gcvCZO%*F=stw{eqvW-pD{_L#7 z(85nXbcR-9Ss-B6pj%rDDlo=WSJ~Dojc&6{MiT9+jXZm@aHr=elv#~36r#J)(_c7 zEssj5v}%2NLC_OBBRx$X?dnfhU^<{Y4&wwGjg*uy{c=V=zQlwCLe=;0<=?)QDW4`FBFY=+>-+h%?O|zrKmf;D z573*TVPJ@GgLK8i>Fk^&OflE88px=6Sd1~dcs?xI#_EkqTy`rJ4M62x!I?OP)uZzgPggx3`f^m@QL51H~PzjwbeG@Jz8LAYAd zIUv@=W@aA#JN?2bT7BXOKVkl(y__(JaRLk8vi2*Z#{IW4FXl&K)qYgkKzY|BYR zN?_(|Z94DkmWf095(WZ(09^^3GGgqTaar5LN%=6;cj_$SYtN_I#6Qiv_6M=KXs1Zyj4vkKE2nrf;Db5{& zb-s2%-+;NqCkK3LVz6x5br$31Ms$@Z{Gc3Uz>Iz*+J}&7%P{8n7Np_u0$_%E@o{%Q z;o41bYbfK*(_9G_a7+DdZHv-!avLg!lsA+agk5r8iUMDv)i3rgGHxa{G(dmV0nqS- zEHGi65Ym9Wj_2TEBwGB{d^$Gkv`t|lp<>KFajUgA^y9fHcuLS!8%i=^JXB%?7yo6Y=VT!|6LuJ zD-oV-p>oYklm?tXhY;&c?DU8oVXA&H#QDL(!zxfWSLYz*%$zq*ZrAjVO?|ni2L)Eb z>%9`m79d9J{DL82<^$oOkTFg|`Kw@gUQy4}2A)~e8&18LidII|OGVO45&k475{uq)VrDK|DMOs6<#ulm3@YWFAz;#4g3kp#mK^i! zZyTLj32bVPx8vCO8YG)B4@3;Di#i*8-YKlH(-glxA83~-M4OnJCY~Q3o8x~o4MbNi zh9ZQw_dq^aFqL=GzXPu(i>iViz#|j%9;BYkH^D7?^7On6LPT<|E>opHWydvO!Bfrc z40+k2Dv6E2)iIZEQXF&9KsRcMcIii zAduR8e>$a2OY04+VSV{{c@x0DVEzai=*M(uk$+-boN;1Wk^nxAMB&_s7ySq2&Li)F zm&+`o_a;hRztp#f(@SXcJ`+H5iE$=b2HbB@#J@PB9e?&`t9?Th6oJQdMJU)7}QZQyLN?Bmgsr2p%7?F(lW@NhHb1yxeot1slqZRu-^JEPKr*4MdVg?*b3 z*OSY%fi6AvC%Ep)^>o6gslX96o}46UGCCa9Rk^1>r4=^}yS9ZWy1Ux38mU|r5i#*- zV|#PAI70RF%x`azCtEXc8}F9)XU{SmCyS%!*N-@b14Ol3$<#H1eRsba^IxgPcn9K6 z451WD`$w1cgXZs(D=bQLxF% z7JeYf>exJ{_9eU#jRAh(@D&an-6h8jFPQY+9oTg}7nT?-v)aW?vA{nJbEu30H|+~p zc4{9YtiES_n|f;8=(0YxH$^1oN6*5!Vem5uwWeEe0OruD>FK!&VlTGH7aMUNoV&t< zs4_FlFnXT*I9qk!Bkot5~W0JA+No zLq5+t-(9%L<1f;3SII8ve^e2D#^z4rM%Zv3y91%m|Xx3G7XrrNSgqS~tF}+X+9qe)I5?M0-QV^@#Ec8%w5<`!{M9d8Y zW=~(^$u(LGxTIaM>i)a75zMBRWv-WnaaSL0EJm4bTIY-OAnG%S#dJC;4~o+&7$&F! z19+~HEs2`L_b6{$7V0fUsHg~5s1>WkGp-&4va1uuY60rT6pjr#;~{D?B4}>8Zl&>` z@kCbF(#fojRA(QbY=jDEWH8|#eVghgi!5v908K`e2{pBGbycsN9Mert>~n885r~eC z4xebL3KNwwTwF#Xz2n)bHtsp$%pN)?wPY$KZin8XHvYkG;VQ>a>ZTKdw(O?oTTYDo zp;Mi8o0ev8$_ON%s|w9iNs4qCTS=L*i=rj4T6&x5`*1_&-3lCw|JZLtO9?f2zzkB_ zacNYmOA!MQ#|^HT@>?o=+q_LD2CZ1pDRA=dj(yn9d`G->?Sc3-B)rUzX6xt#@nRYCnaEYBsr@ z`1v(^;v9|C{_UwuWR?AmWz5w3V#2()L;Op{%n@nt5KaEv%*sr|i66g_5f3mRk)Now zvVB?>)`MQRc)C<)`s~RK6{1sT{qFS#Fkyv7HlO%h>0rj|m@mvp#96uR$x{1;0z6T;w0x`o3>$x9h~M5@sH66(fK z5*9M9<;qbU%h_~@akp+LgP)t?#!DZq2(x3hw_oWzSx3&u2sqXG^70A72PfishU-!m zm@$&_65h`T2H6Z^pnKSLwFMkR(KB$vn}o~@7Z%H&`+CbWx!sxu+@p62z{hIw%kdW( z_^Mk_f3w(RRsY=LwhFx>7qE5f>h9hHEH>!lRm)=#z+OkKKm&{sglq9+tOpiG{e}M> zS}}lV_P*9qZ797ZW_y1R`2qp`LOh#5Wf5VC8BTWn4}51tBzERm&`?yx2FnYKirU~x zqVFvNJD9kc2=oW5S~%uw*mjwIsAr*J0qly!sCuGp$tX!qSxp2r7lEH_U!K!-rt-p_ zCWv5i!nwb8VHZ{)7_?w|QIz~8xr!rW!xdS}e18ZGh{^k}GM1w6=su%#z z381KAt$#Ch9x=ch7&=ZIy`f#C?-D?3gn`F!k;G2?7JBnn?NqKs7{348umKTZx2xQ3?e`TM-a<|PYBcwK`xM0;ydom$6V zrg{~bO5Y?YJR&-xhITJ#LDd~xSK%rMH$-vGN=uGQ_3q@Z zMn>G5^*wE5ZqSM1e*e4Fc?3`b}fGEFUtUF?+?Gt+_{#y`3@co zkbhLOph%`B;8Yexk^@T(c_k%cAnz`pF4Dniy2tR=T~tT0oicPvYK#v^yv!KdZ%A|w ziuJJG5-QGCOmo@ercj-L%V)WRZcjxVjDaxWkTTEO`9M-?* zgUI+RRwxJvM$=e3lsH^J2~{yG4mhE_Mr(E6vq{&mv}H!Tcmkz>TwnI)2&5GtI>#bSHj z0g5W*nceT1DEH-ria$_yk*{gt9MRL486NWX2Bu)m80_CL4)6&HdA%D2&` z5pE@3S$wqvMyErJPs6h8AkVeVxmyWcS zP+E#=Jr>BnIWRmZr;y6`5U*T@N_z@fa$AoiXVoZ6-`?B1P1i3U{`MA3_ExW7zwUV= zdF(AVUbO>;6dMtA=Lw;L!67765`poBfCj>-l#UB7XYOCe{9~+c=n+vkCw(%yC9r8|0VPCMC)bQ814M*rh`<}OaU9A;0-$S-})5@qp`+8~O z!^!T;bM9R2%utfA5Ik5820y=g6x;*76o-D(b+4<(=g&2(;5pd2xQ(ec8xEER-doFn zu|W>PxCg(1OzBx}uj}J)fw(sZNCX4~C#R?ID+-;aDKs`&RnbfoZOnNYxY+#gagMRO z4ASNJb2}Zs2OH!iHL=EN0j=9>+@LuvES7FwNfB9%(&qu=RvCCzZN!fuN=mW{1;eK;%cQod&w)G6X1 zL^NX>bV2J*rVa#S;eNIzRK4t_jxuX6f`3a>3M*8ciHDzE_&B?^MeX;g82m=wQdlYd zzI;%qXfhGvQKG*D_lopZ%R!j@+e!Cp1=c%Jjd(8QO&H;GagcX`4SXvA`SMg&3anOn ztrxCO&N7;sZVw_t&Finm=;!QAy-;ui}4Zjtmop?8(k?ep_6@hda zJ9NK=}k9Sem58o1BZ4l*pRTFffd1l>Lh@GODYH=TMQaJi~#BAx;h zNy+$V*~r`LzwT$3=(KA zf<@mmySUmf&Smb!+osi+yHaf^W9zcMlh>P>?_##ZF=qb7T7(bJh2C7p;f~D>fjC4@ z!AJ5f?q`ug$N_%-Ixq4PfVl?zv9i4UiL#QC?GtaJ8$5?1B+s7x@{K!HsQv$305D{x z*;rdEF)%W0ZO*v+H#=o{pg<+nso0_e6!ec%B`8KZn#f^)7O#FbW)SlyCZWu$()_WH zey)u|YNUaF{|?@=5$eo1la}SJH;4ADq5a~sU?yCM;#}2ygSn9=N!1azG6CXG3-}F7 z;q?B%_wd*SubearR}qsiqN?t@Dy{xPYBSmrFmzODy4<37KYt(gfBXW$p_JZS@K8kO zHHvdCS42C3^i*K?2IzV0?B~t4v68JhJ|f`!84Zf)v_5y&+6&iHbU&z_hPWLyUp)n= zlL^`zBI0tHAFotTxwyzGf%3f_vfhJ`)YCnNYl4IO$CiLDdOS3=>EQFA6syKPK`0N6 z^*|D1?x#NzED6j!9bHQg^~&AR%5ybFQa+kGU|DdKybY3Uil~7exebtygBLdkQDT5_ zU=09s&gUNgYQSMX@f7jx2@M?tQ@6TA~sW5dnN4dwctazn%jF;4eHqJ@vG;wI?(T zylb&>4-XI97Z)jkSuVi(j?d2r-@bWMoE8`7sQhIM>}iveNhww6pFhv(2QF;O#$ZWo zR|jbS>v``P$Ko9$SJsU9qu6Scc7T&g9JYb1)H?2t9{%OuRg=rbqZRu7?@b7SX68m} zzCzseD+>JSL$D;u?-64AZ>P83kCUbTY~3;!OvScLadjs=g;{a-O#%9W~4eH zoWeDDy?dHJV1%yX zz@HTYK>ALwolf~TsR54mabQc`X!K4xu>Ac`M}#O7lbS`Z(-+DJoB>{Vfp>c8S8FW7 z==#>2e!57;ShyB8>i@$BM4&DrDWw8x`yadDZMn@ja1 zA*Fg-P~`uU3Q7E|j=6#NDy0{T3VR z2bz(`h0}~a6X5@W06d|GkON+U*&zPwSBB@$pJM@Dhcc>PDfmfDocz}-l9HH6UsY8l z3ZhlSJ{lYMo9$eLy(U@Nuq{-j)?LIXCCj46H`k#XjP`SQ7%6zsjkf7MzEj)?Wh*3^~NzS93%S8ky3&&SFsD7sFgCEDrN=!4J49ekze ziS)`WZ=i+LyqCY7-VIH?WTjxx4Y@`Ul)XTHo1mjZlse>PPm$3#*#F8TzmWCvV>@^d zo@72RUyj64JCc6C+Zi>BN*5KXhyF?ZcX>3Yc4ls3vYYbyx%1$rr;d|ZkZpJ&%}?(| zHs5&I15_~-e)H`QjhE$O$`qW49o!9Z#+;v$xh-GsW62nLO_BP=8%#SKMfw)Ep(bn zn75#(E5CJ8*FRpY#va%TE7ZJ;)PP^b61YCczyAt9jcL#R-g9lSn0LYfB7nw4hD)F2 z$0(>j^@Bux4^3_>w~s- zDl;Qv2&f(RNt=&NO`?vDj=lZ;bOHibUym@611jq3>cELYiiy0tzYp?qyzeXlzGIsX zo&;|o&%g)srBy=8O}$pvjT(34>*pTLOWm_=zombb287|8eir;mc@CK`vDdY&|Bs_eWSkufW=HVebt8;3=}Iv2KCs?!H|2L+{Ss(Rx4X=Xe3*%-n33jb?Q) zaGl~d8=`=<5K%*bFAxMcdUIO+5yJDsDX3si|}x0AKfR(u*KkPkWh>(?*-@aX8r zV$UK7cvy(RCqe{$tnEz2YRYkS0fO(GYZbj85nr@`Eb&8*102c4ONnQeNz?dauK7#a z$iy}2(Sf3++t3ti`9pxB`+I3b5%cHBUtg9`JfAp$IhcNri~L%!YJ!AO-Y%r(gp#z~vKe#m>eno;bWiMVm8H?1gsu3ro4WUQKmu2QGSw_W~O$7m-{1+085PJ|5g zjpC0#5(Fw?T=5q1(?qiZt_~&SDK{4^=X1gIrU7GhoGx<$ZNTM}nb~mN>1CPI!~KoN zSWm%Xxoq?r1|l4m3Qms>bPBlhK*fa(o;=qg5Xv7(E zNa?*{ar~6qpG9PRZbPH&pSv`3lI@3@nukbwO{*kkf4FKZ{Utqn`~6o}VMq5*@2Q(>^aq6=NtuC_{ToL%Nb#+%s;tBVnQ95_I+w{HQDO_cU1dN4uRR6`-eTRp#}A~J znG>RCvMFaD{Vz_ABUzi)F`DC60#By!B6f7y?XqiGKez;DAibtLq0m3dK(C++C@ap{xOA?RFD*_@0F_k=obWpfKhGre z3jm{LwAM-kSf1Gdtt!K785wu2vcFSPQ-C=Abgt(mY}eb&yQrbIfg)}`Q5Y+H{Dem0 z(E#cZ>Or5Y}WXGIjJWU_E>V$8kT{H20R3FGXfZYqB{3B6I3F9aX%=W9)GtfB6d z_;l)^Gt=Hl#L!YDAkl0Gl%*DqiP^jB>xF}l#ell6BOQ{Fkx{6chyLo-s~%ulT))5E z;wuA)r(;iYPIFr6et_`+_&-?L%S$(1oobTJkV?%M28*!Pw8rk*J1CFzH`P?vl+^wz zbl*n~6*Dr$?<6~D$vlM!JkX@QA5vIOIql!AVz^!o& z(Jr&^Z8|Q{tEnh;Dms=&r0D(SEX>K6tcjg@HG()?so3x}F9>ld)(|@;kG`d44bF(F zf)B|U6G=Lhse&?U?!?AUe`-;Qa&fWg#bMP#OFJt6&~XIo45^VX@{30e1YCyrPsmyC zHTD?;0V1^3Vo+m_SKfR%M`>&V>Zty-vGIL-(DB|(j_mS9%Rh$d(vm#}(nvpv42kI8 zKV4V{Z~>gXlDIywZuu1;Bjc3c@hT0m;QKNgr^|j{r3P1DhYL zG@B6R0L%#IR{55kH6TGZN|X~X6j~f^LQK1TZcjf>kxEC~WoSEsyudV5s095W%+^1a znLdxsz9DVLG%`{uNtBb!rkRN~A6K)yl}gi>{@ysHAOSZctC^}Wa5upEqb>hJLqyvP z9$+Qzd$~NbtEHu-4tTYKppdSttXPYPG$sN8m547;(Y*zrj-uz^()#QmTxP)YGy+iN zjS(C)^xDx!-?Q>`M^^tZ$NQOW=2azOvL`}*BG|vLXpfwHt)M5HDv%1nx930*kMM7r ze|DV}fK9*Z3pe-sp6}J&?=p;u`hYHn3R-z5UUWxxluNf)o&tsIm>j}#QmnH&Zt5Bf6Ini+!NN5+)&Q~H54r9y%}{;#t-Iczq>-3_T3+a z*N$Sw(osw|K8Z&oddiZLAlfV%zTu_lYdE_ePSoC+(Q6DsM`!ethPcmyIRSiHLl*=h zW&E%BzagHN`&j_UL+a{PgGsm?ie})Gzj3tuq2aH86dRLlKA-a@$tMJxnxEpQeOsAx z0P;bUv~2v>WI1gpe2RsIW{Mq*f2*aQv7USsN{qFDsrUKhw7qMdoP?U%X!~#|_TQba z^;kugUKcvi*w$d?zqeYxzJKGevC$@fe2{H-xf++Cn3G6dTeFUQ0i?6C2Bv2E2M#lBk z)hz5M*jf}ZG$=R0 z-jScU^~?XoQ|*yClY5X0v37SI-jsW$%Lje$${w*RiF}2PGyY1NMe!%{W`L2dyIa57 zUjrw)H=g)9-EjJs0ZNDVV&wZ2wbGX%ZA@()a7!$uYTniS-+qhNsdONvHnawPxE6iJ zvFwt$k@~%o(aWSXj8)Iic@&LZ(a{~hlj!w~y1H=GrAvc$qtu6*UzQSWV86HV_3_D5 z0Z98CTwJ1feNAo#LULYbqzKq$TF6-bP@6s7G|NPKU(+U;-Dk46T06aW=iw=lk&te! zpd?RAPal+?P7%QXKqR2YvUmL43DyfZuCBW28BUymAxAp(4(q!t`uf84t&;ENmL-n% zHV0P4^ga6aA_bN}W^5M;SK4$L(hA86h&dY~Q6y$tTYpz+zX}b+tparDB!7Q@4zQ3` z2A2Cx`9KkWE9A5V@^hOEp7fkg3=XmRS}Os{o&WJxzQX6K=Jj*)JYV0ZmW>K__{W{V zrg5#bzfoUo2kUval&n1j;-Y*jd2>oKGL;#%s}Z zWX3VRo|fONGbuH(;p6h!f-8DF@0_)fN_kR_{R`?!5G;IYB?sqEblA?hTTx82tmMtt zu}-!Qj;oLY;6BN=Us5Df!`rG0$V6u-S$*FvY;2LzK`o`I%%METYB;-VuudjHTkdXM z9n={n)1egH{a#ma`HLK{uR_PpR+owD^nO^er*DZ$z)HlqOML+fo`R!mYf$w?uNItu zjn4L$*!R89@fVPIopBbpp8 zbc0G+Zsq#7_stoYVMu_2!5B=3zyk4>6KOmrAAGA2Um;eo@TCG2Cckr&Soc*Eg@mMW{FT@*(O?x<0bX!x8V^9FWi$Al4%GjUjW5wH z?UR2ftxM$p3^7sQ6$Gp^?q($TnW^qVsM&q#ZXFhxiL zMMJXZ(QaIo;fzqSQSsZWddkrtbyG_#cwNO1;WBNaQV4k|+SV*)X~bbACi`LTvV~kf za)46xD(Cd78=bV7g^{sueMy4ij`y>sk|SQ%%!$*2>?+ze`!vIP|BF$34m66+W}JgT zQB+^e6C*8Kbz~*%%LZX)xa@1sOwYrgo<6Q1R16rnYrPEo>lYds*)=?TRJOdxA^yM$ zqN9faD#7Ci;?2)jf!RnNz#<0I1foGIEDyNh>tNKQSl!vV?kI105I$}7Lnt8UHMe&I z;<><}pdtjh{|3?1eV*Z7J7SIn-F$0YjcD6M(Qz%qm`9`Osx>-E*uJ%(E2$2p`=aN0 z#A3bg<8y<3K!CHoS*8;|Bw5C%k6|D;9*e_}g`tjYx3z7g`ES^^^l`OXh^5!%{`qTL zofo*H_y=w|u|zCuItwl8gOs1r)|RtUuV3Ik{P?nzoT2}lUHhU|)b7l?^h4+~-Rt7z zMN?r5e^#>8-nsNbp&NV~a!2%yz%+S4YDj(h-L158%9g z3JITk96(?7wgMbLY6a#-G+OQnylfRFbPVRaJk3cx_rfY}5tn^Q)K_2?6gQBF@vF5B z3!Xp$nCIz_QWV#iSa>_4lx1dy0XdAWHide#qKZ&P{TG7V&H*UK$7)pcMeqCWy(PM? zQ}^Ik82`fhCOxc^8@_zhw@+CUPhx#&`;3zsYLlX5+0MqVG5?ifd|B`uY5L@qjZgWs z0UFz)x6)(9b{O^uV<<*}@}tA${tcq@2@tgkee=0xhJZm~QowS;JT*Rk+!cr~Y(R|_ zMOp#$h<5^ZfNNBKtOB14N-hKlFoN{)Y6Z;w9YKlv^O&JHmXbWY!<3P`1jns<#q>0OYs0%^a`AZWp+ngfi+d&7Ilmg3-}F z2mgX3l6`&VFS#GJHzT4T&&+fn};jN~tE|IIc zNugm@@L}wIO($Y)8d3D=9w7+9eRn%A!F!LK%-hwBo%Hx+hJNbDZu4`#b_XuIQr*4L=w4^ORSQMCP*I5_E znGl6Tje%(h1k_|zVgc>|!;xvc ze%}h-SSL6f(Ma5g%2Zh)akKt={q48+Hk=~JAO+M}aBjr!9~^MTrR0lcsKZO2FqJEf zuDW?NI2tZ5EkZ+iO$mdtk7ue(F(BZe5z+efc^BtRB1_^K$c=8P2FfRmCHHMgAp9(g z$OSjQ47l|VaN#W&|gde2=|qBm2Xi(BO*T3y<T8)x$%5Ti_|Jp40vYe=O2%X_SB44HE)jf zUQ_XeC_pTV;v$#P-|K$R9p7SKLeK=+?v*o$U(QHA{5E#!iW9fLNbf|a=O&6qW?k7M zGh)R$S)y0?1fRg6r#&l^#Uu?}AKn7U9}hYLv7JKU8|st=P+?Jnc>!QpD(=6F2LcWNO3 zxn?0wGjw>M%P!LcLWg^Z00-KOA1kmmJlzz;7bdS%G4s<)#5imZnfsa0yK+{6kOM9F6IDuIQL$D~Ss z`C5tzKxTDiF2ZoxUO+sBBNg*F7bhoA%LL2je2^k(x&eOgUL+}(KiGf$@AorGN)8}Z z)>ayUYsI4_V*SlZH;nrGQQEjCUId*kkD(P1kPMscXX^V&=juAL0L=0aTR>!-nDNO@ z#YCbdZZ)^_)rJX4DK2SvOIfSTB4?H~NQT%wC3bBui(s1T;Go_==o z&p~*~`QKryP1Cn%Ssd+cui?g{8y|`CqwTXB9|#Q{9XtdWkZw@$@Kg`+*RuH`!BNmT z^gSabD$HVOj8{I?iNcCiJl?krem}nTz^>vyg6cKrEgL=~jGRP4iVBzkyv%lX|1uVsGPEJlb z_<^6BIcNw)X=q^K(x}Yda3&ykD`xQ*==|NM_onS$Dy_^7*6Za* z{3p#UNLHHg{X5hfAtZ1%T zyMegq&Hm}w6y$|w=$T~imFH0}LW57LhU)wFc*bacKAX9OEnnPI0(OJn6rd@Fe2loe zxjA^r#if-71fEqOnYLJPTRT5L|HBKY+%5(U1eb^ishiZx+uO<7#yZ5sdU*?tU(r;s zGFqyLA_R9f*9ii?fz6MvbF!Rkn@m~N|2Q~WC-WJ1qO$2WR1CH#c58l(3*W0vy-jVc z9e>Yz!2SQZ02Juo-Dx)NVi4?inRry*$te#H{=$GfjZD9uu1~uL6*2<+OQxfuqRy-) z3LQ3q8Ns60lX$`q=otU+^1wVz?E$^N|96y@lHy$QsqhZ*?4E3hlJy&{G_g1-Ea3%5 z@@|)6VDK)I;e2NXpJ?7U>Z*nOBvPqLpV7+%iP8}&vY5Yz1x-z^oM z=lQ=c2O`cxNDvTR@B@ohBE>p(0UQD3z~BH6AQ3@eyg!`wRcE&ZG9c<0Zbg;R?v7?b%vJcA|-yhDu*!hwS|%Io4zMyG@>ZTzZnxu5{u8&x-H zQt1o*DL(5NTu6oSyU6#?G zvQm>0ENZ`N-lcyOca2?n3FSJ;Y& zaOYxOS53KX-haG?z~bix^UsZmdxvdCs}i?UYySeDG+bihCv59$amL@7%8wA3z|R|! z7bzAbu@u8GD9?gr9)xHSsPf=(%6M$}5_#0v*uFs|Jv@XbgJT|5UcW|$7y_xh1sFXR z4DIX;-1a7zqrqm&9ry*H1B0g=aMvD)+lD=|pKKGrRvQAdnl4}FEj6CYlKR-ls3{a{ z)NPNAE%_TW2zNGy)g3vsi-J7=l~Et+RQBsccspw9VduZo;11IA@)80%FsrLbRB3(bm>0FDOS#pYO?%wqrTPd5LTfF}r%{#D1ZuC$%mM!Ntdi*3#w@0?P&#&_`i+ zCj(6dy=)qArr_e_EYB=2w+9D)mjGGo$J>Eq1S9ccG){o>~X!hpw;_F+d) zmQ)A?Qu|k+p^SM$!~S{Z>IsHqRIpKO%gygNl$ku9)((@2nyQ79f$NpekYsUh;mME~ zRjA9WCxM+1Xid2QH6j{Bkb9*8J>*ql5Qr3DPJ}~@;c%?+x^aZS3JSKpsU=$Sf;|#5 zM1&@N>1Kq#&{iPz{Oo{ni(?Pmat4I%|J+pY5G%{rCf&x)b0*Mgyq!dEbUmDDR@13} zRqxYsgA4)Wg%JRvI<}nESWRO?aH*&q4i+2hSy@P0;MQD6O+KGqF~fU3ve>>aMc*JK zbO9Ca>!FW~9CJcK0wU!2^i%<~CYkTR(UJ`o&>_~q+n_fPjo>BNVzS`V=6*)Tg&d!q zb>zy&Lm;4)^Y-289X(UCn)qyEVc=_Bt&mPTMnF2AxPCPNdvK#3u+x;mGjSwGM*VnGURKDu_uWlBKT zUIo|FrA8<{2n!+SibCRsxd`+Q#;2VB=0RG)$1LOzOyCA)Q`A${+Ca|G2AZ75?1BQb zXA~3*X-;LrAOQH610rqiIk;?U_|TRX35X#$V6U2jG4(7hO(yIm&FYu;nmjvk7w||& z!`9EmcZCW1_t!lLB5fc5i)+1tvVv zq#xHJ$pzGV6OFe2q@h4&8Z6GloOs5i+P7W(FhUAR0`D)b((qx=|Nad7C0bRjKa7_4 zaup2%?1ojnQJI5YN07o97#Ki+(7zSi+Z!YS{rp)5D&LpYbk@8NBxyuV9fFf?nxSXbmN#qmStF}WK z#`TrCAlI=M`YJtuM}$-`_skUaW(zMAuKWzviJ(}?^oU5(uZIGBV^qMwl&7hvhzV(3 zTofB09d*b8W?_k7=5)CNKiO9=X>%13aUn5S1^@^mh8T`~f3?dv+-Xqf>WE&!%U4Hz zBw%ieke3~jh%L<%;egci4E{~KAO{74egOgt#9^QY`Prwu53qT{zaqv7vcjSGJywpqL7%X=OB86=hGl$TX$f2*>?|&Y{5mv#YZ5f zes7r6QckTG(Bn4u~y{!wOiQ^*1BPYL`RR6AP;f+^y{G@Pu@;(I&-(mO|q?MC~ zWBKR$`DTUYg-mKxBr77uk4w$CPQ1*7V%2Vrm)zV{Rqr%a5K)6*D!*TR;)1<_RFdKn zN$JbOdCX}KO3IS6c!Xb}tFd+IkJ}@yD>rgz~%`!fjsN$>qI=<+`*WnFAb4lFhE{50+=5-?t0A> zY;by~fwl4(PW?3qWSk5O4VAntPO=m#=TY-*ame@*{$&FN`@{kn`7Vi5Km3bKSB%^X z6;)OLuXX%9e0<*IFX_xH6D$3)f2ygKSs5mm7v`SY_9yh=J2{;Rd=vM9LgCXhGAxvD z$nXDoiRjA7&A6$}DiXxk!zuJnU_iy!bUi!|WSJ%H83ohS!;7a|Kdqc5Cl>&+LCqx! zt?3|8Ul^L3qe4(IFsz(`j}d}^-IAAtacAi0dQY?g5OK>mK~ak!4@x+4Dd;rcetBH5 zSligNjCQXo^!4@q0PaZZNJvPyVbUrZ8X-kR%wXL?A5ke_aMuiAu59IR;x#1y5P)Vt zCXL^wRj7P_wz#Keal6cI`wDA)M=XIh$>UWoBb;<3T)emYh3s~6QJG5*f!W&Cdm~il z#@CV0g240?;4}mZ!ju?2y=mgFU$>>8rMv_N*`6`!=}!)ds#&O65cuzeIBmDS4{Tlw zznn2ZA7mIo1Yx?aUT$$Yc=nW=8&dxM`g+^s3nzCscRN(dx77Q{C+$s-Kw6fCnPek3 zO*SrcHQ>$k1 z?DvmVD4~!aks4uVYj&ZnpY#Wi8vhHy@`Q)AgYQIFS{f13IyT1L29~mTB#FYay8jdUXH)jwC=zv}TcVT8=el7z{;L*Slz8nMg3`juw zc>_pFN*TAuj|~liEL60FlBhS^U~3K!A>}ge>cOET6`Y`ATNP$#}7Q(O-T?1DV~l13WLDgM1hu z#6JjVH>C{?X#lYT;2_$Vzz_5eOlk+<^+g7s-iH|C%g)XYX$4=jGkCW6c>sWZ2$DE@ zm|0oBJ#f|uh>KGJne)GWD|L1Cm2_5MxL5-e{z*3gBE!HyM~`4*E72w}W;fF^efj9k%@&Pyd=4B3JQNz=vs*PjDfaFOLYWbjm{t`%cvBl}cUqK> zV@uv)fmtep$G_!Z_Y`pYW~j%<`4m(wEaz-2Z2L_f7YuEwk@I9pp*??h$hP@DSG>n3 zBBC0foD`P$G&n;7$iR%GA7#GTo`KBX(Oh|gxk|a8?>^aeyisTYGe$dj7a$|Wpwa*o zOxt1kyAOS!4P=53!W9(bsLX%PLQjVJH)`l|vYLV-V@^3)FjifZF*p57WMmK^WIz(<7JUo1>&@?5tee2-Af+0*LJE71HPX8~~#`)$5tR%%cFxSXv4 zoeG@cXtoS^(-9}bVjLBxG`G@=Jv==_jzERb)z{A~{Qg~1=>#GSSkk-jwFmpk$#{xcmOf{gL^LQ*C|I2pR*CTImpIV`uQ_2L69 zhj?7Ps85g=Y&%Uyn{cx9{n_iJp$ra8u#pt|xL>(%1Wu(dN*ThVQLp=TAz8GV8zJbZ zs4-NYWCIcD+@|5DC+m)a6^@XIQoAA9qjCC(qWk$y)sd~hrCd4%V&+i$QRQ90^J zt9u9sqxQRNn%wj>9c|N3-a!a2$At@7cmquhj*3QL}FnI)4#g>xA+9D*&t%h_NGWL>5(Mm zsmA^vQ*Rv>)zCOX6iGYBFqDX^)Gz=giE!_;= z-Thmf=X~Gm^)KbpanIgsuXW$|rzQ_}<2!b32LC}f*zYU)bPVOu$lr0Y) zX)(z95xBUxOzbItl7od@B5Z7I_#ZrI{=K`)?qbPMG2ROcxV;Ua0ci&!NdC8*x`k)Q3i9!(0QY<)_A7}bebyQ{6|BAvf(!Ia02&9 z?qh|L4prcCM+|yYdWe6lEC1#!#6`t{o5sfE@+nbN9sy{vI|+MX&nFmwS3I(A>ze3s%Gn(CDnsGvF@4cAZ{ECl zW^C-=1?E{&%Y7L!VAy&!+n!`N74La{S>5#Wb=P-#8RxpIC6y%d!-^2S?W3qyqLR3F z_hrI}vUWFMnL_mPviLl#Hx%UPo|q`=9pti)4i1+UnxzghXc_>AQpf~GHSaviF-ZcX=fOCYGkYioiKOl+Gh#bW|K-ld+YLtnJ^ zjdi{&Lq;9zOdEk~>P8@BWNZD#tE0IcFbHqYiHBgI^Utl5kN8SteEeZxvGJ(|=rTct zR{Q3;|Cs#tH0h5wIM#XB0%6lE^H5(X#+FzA+m@%E`aEJX7en2Mr9*4Eb9?yFO;gFZEEvwf`UAxK?8 zbZFpk4&HWQW&$Nlv9#Hfr{=)D0v3_s{YYC!V>Z2>QlkY!oz>MrX6Ln)# zd`4@~I`w9Bcdi8#bMm)<0TR?1*4V6Ma>}hP2g}bPxeOWKbedFc+(H%-$CqOQF{Xn) zc<|Q}J`n-qG6oxM0@_`jW~K{l&%e65xy?cYp^Z3jawSboGQd~CfT)D5)#ktqymA=y z$EILr-RV7Jl!Ewl>8~qyG+4+;Ie0X+o#FROna)(8?6k1LyU~^!kfwqq4UO zjWrUv64-4|$;`u*t6bbN<7tx9O0p}1Z%UhtW;%>g3v?8p!1_ngHpX$rMDrr})>F9? z_&hdCJpM#d(du6ab|vwhET-WDhl6*SnM@N;a4|_h3d<_!#e0EW7qg0jnVF{!GmLIX1-U>pf-w>UwC z*J5vPFAX{?mt9Xs9P|KC$Kckwu6@CQ1g&~Qa&p+kR)T;VmA9VWuo#H|>zi1;Ii4+J zbj8RMi2(+vt<%`CeU^xsRa$0W-iCyFg7i``LXl*=UT&+kW#dIla8MHPYQAUM zv#v#G;qu@fGqbf4>kaN)WrK~CRXfyi{NfJ~urTLZEP9LiU5cd$*#rS2!}&jhLv)g~ zsa-o|4-TXJR14TC@Wp6^%uw$rxbEMbQy}O*TF`qEuKPJJ5r2B3G6pY|A5IUksiqTv zSlc{uIJquBKtNc~9YA~s8A47#W$FNuLfdR@ZFT&Q)<2Ge(psHVF*!Q=#cO~ToPc`w zB8E{m8lRH1kp0=aF^XE}`eHV3_1AhaW=%usqz<;Q?_V(3P8WsL|EiMzr0FP{{)3C; z%7qaYA|=P4V#JbhY)ZNHt-jg63N);By_x zJS!@5C*Yx(1<5~60^hZHe4HAn7CrWbgxg2jmYuIRTy1dTaKvfE)NwfP&b5H&DUK{C zyiZY6;m9a#I{(}CwrjqyBR2!h4-q_|T*m@bj$**PaUJ-Nt8xPj?%TI-uT~Zpe?X|6 z*+whoIF17_?O>0>!qmr^9bliVL!YTet5OS6; z>7)rzvEO~HP5SoiMdD@phepv_uO;W4-GA=#zNf$F;)aq%9T|WZq&y}Ic-795Qc@xT zqr)EuE+Rt6>${0-I*?AnFDDPr)(j=~#3G}BxmF_oR;QOP29EtxR@pxSi}-MK9Ug~MC0#Z&dw&wA7Lk0q`U#j*Odz=?;WPR zR+s)(o?QI?{rjM|w>KH!>WmJMTt^HJQ#q-`Ss!RXh``T5eu&&2o{ zku`?USA61O&rH>{(IUa?6}g-BJHVU1%?Ck6|OyU{I6QvqCsB>-0)C$!i^JJ0Og(Vl8mL!*yv}DG>h1G4Mq)VEK>bBV zrBiywz4bjz*P8GEba zv$EiCx2K*wx+hC;6cGFJo`Ap|08s)nT{JT@ooogfA2E-~5uTt^7hK=%&=a)Byo)8J zRvllvOk|~fz=jWv)qXO6L?vjlV|+}rSaILvcZaU|y|1ni6;N`Aw_(6TE@i=Zqa6rU zoGy-eKKNZ>_evvHm6H;MXUxNitBNF&l?lExWwudAL577Oxc>%;2MD|9xh}J&c^kDo8N-s@yC7%V9ba@IYQR;eeCin#Z7u1gIKK-aUMxUV3`^ zM&uFpujmvr^5Y23HGCcap=Sqb6}mUSI&bklpdg_U;SDpM+~nW?fjpIwJ{1 z*vy$5&t%y{P%V+`1y2Y~Y?)TxKOaP}T~BEm%igE}`eLpupbmI=daD2LO8;m#*^mEZ zg-k}$#5aJCN&mNsuRU5Hjji}YTrsw1P- zpXCgZ_&>x1@Y74OH@U>WdShH}w3%DqZ)lIl&+GOSo|Vae&74H~4xZdY6>m(@5J*hZW){I2YspA_~tm z)NXQE@(NiuLrh#11$FI6o>uh+wS$fyV!F0r21CwVs-ukDP6;DYtR@t^}GgpUd#)F0RgAcn~lggF$$VA+e2{AV-xEbTp;rSMJ+0m1;5S zryTh35P`KtS2-Gawi76QwpMM&u6gPGy~hN_wdU2P2bSU^7zUf8+Pc zF~Y*e^>EpXaNW4*jg9!?*dL7J*aj77#}9d zevBG1=v+Wg0^AumHV8TA(`IvDWvLZU^V5&F6*enDj zS!QXl*Tw2ti^3VQ1a_(IaX!)18#XzjZ)Qbm^p4)p(n<(F-J1BOQo1>6)Zl{)ICm3G z;Jlv%f)!v$%O&LO{L?EwaVr#o(J`t+m|80+ zwFA>WMvxowvh;QjcLE?73<8qNBhz>4Qx9iaqT^rPuPx-#5)()GE{N%rCmLLG zbdU1^t5E@%cK&-WX;^X)w`B+#2p)n5_<)LF0rQLRF zlg6#_kzLTFiT0k+x9RQyfDN_2{wiqlShnb6k0KLV`I#pj9{#x`f~s85#i}Cj`H5=y z+=LD1X$yZ1w8~(u`RG=etgoAW2ILOmAz{u?#6SN878mo;h&nuzB!w?B0t*qQy83$X zSaltHYTj>r;G-*M9Kl>&CLp>)6&mAADj#A}CWXwfYBc>vHKTifZ||;CZ<0V8-jAn? zd^@VM=ih+{78=k`M+@KpmP_eRA9qIn_`wkp7M57vSB(H-h<&YR&$F}qy9k`StsqXUWmSma?B@1v?Yz$}Y9ya*~!_$2w z4!8T4V_!Y)lx#9^43kMj;#xY<@tlo{V#{M?1p=BvyFlk7`_Op{=j zA~CN`kDHag^j?>|_~7w$GMUa);*Ahx$OXMbJRQ}#rh{NzJHg!EnjC%~71aWG&Og)^ zZ@xhCozmlZg}`hJGA9VGtHVqGUf*$YL@ai>ujN%qJ;+S^o>9QAN(p<^_Qk&VGb(zF znPQs$Su9=tl!Yl6)5-h8ZS}}!6O&BH_Uo2L(x)<4pBfJiewM(oZJ6S*ce%*L>h2^z zNdBrLjGV-xkzDyX5j2%lFIhf4Q|~)z*~chb@W#|;iCo5J;1z_)%cDmo*aotDq{p@J zCIoQcvyUt+SfEVfo9h>%{*7fnBKPs{GvE~E-8b9_P8cL%#-bU;!r%TKcQJ2iFaGH0 zo8&LYVsgO20v?CzSskK(=}2Ch-o~G{+$$zTq$kS=Vn1NJJ`bRIOIJZhb$=aZDIC~|#W*^IGWPMoxf|Qt z!*QSMRj|UfdDZE@@i;j5cf@0laloG7fgr5%jaz6U3`=_^#~kL?v)-K@z4Sp(c;d5; zwziRo`A9)mp?-x0paGn10O%S3WzE3Dx&+YC3FyQ~Ahkm9SMPvt{``N_{1OnpRa1LR zXRtr-AeBgnCMt*#9KrTE>4cfF9N7o2$9w#!M?4vg9=W~;FYqE~DWQG5fS)v( zR(Mo;h*cWFRVtW7SU{La<`<&x1w=&!SOC&!7ePyr2nbFsS6aG~WRj)q@W)=XfIitE zH-wlLsM`;)310C9&ZA{kQPJpqG|_M5oq27QF)*5+Hk9kKqU0<;SGv0Tt?$Cy^T}gO zOmhAXP*tyItF0x?7VnYqrEe>?z zUWdIK1)F1{uU_q6@ELQ>{Bq0JU*6~*0a2CRJ)NB*qr-zXABYl19`575K zsiO?Q$6&QG!HS6b<|v;fg)YX#Sq*PcM8m=8FUW?WOZz5MQ9r=6Ejt|j#MPdsQ=Diz zh+H-u+35Zn4sro~Amf!b4&?V{-0AqGW0b|@2$Q9ZE z%_R3RC`;k9w~;r*HvspZ2*)H+k%2&P@yX1G*jNProDVY}F9q&!0{N1sdZ1ic&P3V2p4| za@!`2qTsk%uH|H!ix_I!T8R;gA0zXUKOKzNPeg2h&ylikdj=stoqB*ECOjxMB?V7I zLu33S_BlGKyk8{9Rx|~HQMz|%^{sBQ7XE%B?z=ZaYoK5#afnAI!xf?$ZdNS`If(|o zXFne9?ed*Waq&wHGy4|?eNIRtblNfsJcIDslBpQO*{&ZJ&-nUzgE=@a{dA`fFdUno z^}Bdp3{Z;^pocyNpq|I!>E1R#Btmb!XCDX)FM(M`cSpyM4%=OlC;Oih>J}wA85wQ~ znh}waXb^CT_zGUK4C$o%p!(_P6LOdmL-dmCm%kZ2?>#zj!xBd?dTSzdn1>clA}|)> zfJ$PhGo@amF1sM6LJ%VNK)#jFZC*UKzc8D*`y( zP+PLyD+NdnL{NSNi9qK6DBjN8fc?0{*3YuC7=YJIpC6t$PE`eh#`S7#!9OOL0v_TM zvnv1^+QZfHF3z3l+Ov_5E&`?8Vv#nhTA^$(Az`F^Z6LA!2c*N(Do0&i>&|i;_1ui( z5git=-33KOby=-A^?DWpB5=8s>uT)4pAYQ#VO|%P`{zf%w4%7oLtXt23n`JOr#KkB zBLO^pD#FfwJyT!12Sz`wV2i>7>z?f2+BY@=P9dN0>$7kTF17dF!_^F$= zhK4Q2g%`j>wgB@BAIiXtbqpm297Z0{Muvh>G)=K?y_5Cwf}$c3nvOcU0;qf<*9Wt7 z?KhDUY%t0AofD6w$yKx!sT6_ZhA%_&V0~N9Hb_Ir)>ceFE7_VZHkLIszdKku>d0b? zyYvx*G)~#*ZEZLD><=2d`IF{=aSqj_ynhs)?Oa@)+W z`LZ+P<4?BjdsE%Oe(N;@+WEDNuo$2MYnq+S051~x$HGD$v6TrBVyO*8nwZ&2w2A5I z4y2TnR{u5|4*`vUJc{Hco9o61A=o#5&#x{G&sbU=+8U4}Tr#tC7R$19sn)Rk_D=}j zN}rANcW`P%qgPQ-QicOZkc7!mMiP=+vU9oPECb-u+!7~MWeR(a)DyO(D!RJ61$eSM?+yw?LH=^ujP7*MhO{oKqd zaOihHHK(q-l1b~hi!i|S{T`yRDYkAO1;?N&0XL~ zRIOgfx@y*^K3zf;>5Kx?EHwxRGo#*WOq2`nIXSX~w7(yZh=(^+@>-ZnO*3 zDkn#aFdue51=PDNBlP+=0FL19iV`qygP_|l)!!eRDFG;@FW#rrpAW@JTN=F>j~va3 zTAF8%5XhBWA<_;=gNtVMnD~1W&!krGw{1JXtgKp)$V}jNa{Y#$n)*pA zb4bD)R`(tC8t)sYjmgp8q0Ma^T`gE}ax?bX2P|g+)F5fyccVKD(tbiiK%}=0l>mh6 z!9~sYXP<(QNV)9nDS@5g{L!7e_r4d_dkZ$%`DOT=g&?9$i%?h}v$Ga#rRioj>i5?c ze5fC%j9~o22xwO&!_Uvl;R54mqM}*kcP7Byp@p7h$k5;Bu-smB8Q2Zt(J?l%v$Fo~ z+O`uxzyj>&t4fE@J`T$Vx9Sju^ z#5HC@8PMpfW~e_}!UwpLEiGTW>(jwKhe1FOQ3@=`L+z)hitT1gyCnLT3gricdeJ6> zHr@aLVD0SlLCns3M*99nf_w6TLXfx)di1*$A1jiiK2JYGr}KBO^Z`*v713L2+JXfk zLDh7-9UFltD9SXKdO)7i^glo3+-=?E{X%_Kc$X{P^t@b_nBk||u5q2H%$D1o1dO;BZ;?y6q}#*Ux~7BQ zdwS^UXefG<1zIp6Fc}a4{B}TWN}vQPyDgBcY{8A~x5fV(@Th?10eu57eFmMELt=31Gp)=_;G29Hed{;Z1pebZ1zS0SRwAb^(K%a{VSjBAs zr|#aOrz0wyEie3~`oXU053XF49tsdDPCOD4<*sc=?%+Z6!X?RYl(&+L>3V$^p38Et zT4_NN^{zM%lnBcuQ%`tQZa9t;9UwgJF&W-(%mLO`0(w?Duz z9D*qMjPvvE-#_m9Hbe^0#sG}=YdOuf|LJN->;M}F2M#DL zL>>q|U`RQbr;thwQg~L+xL7P20EZnOBK3x0MzX58jiv{V=MX=jHNLE!2I>+8IXMWp zHI_1oS(rWho2v93yDhT67`G~AfW4l99~XA3jENxI1PQEXrr60 zGDVL9Qv*P)0!2?}9`I(F-~$?Bxc83#MwOa@!8@QI@S2&KS=JPnSGIAUYsQ3-%RKt| zD~;ZR#fdP~OGbj$p^Jyt61}hph}a5|et{uT^AQ_R2d69mBmbMTH?Uho?d-$=$cUFp z#<`nhX_3l)Ok_@i1g(3z(d!jg2S}^2bL-K_#S^yIVSO%!F(+m>A!)IpxUr#~(lL!fnzf zz{Fm$1AH?cOtdB^R@T-L07I_;=NLIPHIm!gN(vNtDgd-?=u~Or0Ec=6=yLSIK05(w z+htuny~jGaFPHYgo3IGUv5@Wo3Zj5kG|9_}!?kJsi>cO)w>3{gSFPC%kJ2a@So|qh zpbrrJRulVHwADmS*xR%Nmv^Nn-(J%KKj2`%5`bGTDj!^w=7Met;<`HMe-1^R6Y{NBXELUUm5Qr*d^6bD*K zb7@Ofrg#Ph1E6r^<>zm`*FM0(>fE;5qB=3EvYe&dS(2yXy0R*yzx3+xa;4EPXG(mc^=YlEHVE44;1o^~3Zo<0akm|~48+{N-g zPATL3z+P!Lm2IN|EtbgLT0+*o}F`z%Kcn+eNcBe>Bc0mBoMRkF9*8Q6YY4{pWt{2m2wa;8H2 zd=GQ&VwP{P>3E>^^UMQOeKbhc?mY?EV8Q=$CinJ)o0a^1 zUPS@H`G_!B+xYdqva)j9zxp`<;%|4rw>vY_?l)O? zrKdOQG>+}iesCt;?C!12J{l=|)rDaf&3@X1eu3IpaIpi$l`}9fYHkk2=M1?0UW@H< z(^pR)X-!|RO?M#*Rc-xacNEbyMW8%dXt}MXK1wk@A&6*kR=uwi=YWH1)q9-KP+h27nl?xHAh_{2;RHQWtD`6U2_kN_rj(y^ar z`PJ1R$&M zDh8Nq@oOJae3q;@Y4F(lvesu1sNV*nr~o zvoHB)8hNrc9txVf=Ky{Dh5*|tAXS6^X#Wbtxl%#9sK0_dj~2DuN-%n^m}ZlxemKIY ztkEw{7%f1g-OXC+zxoon6<)(2FebBlF!3Di1D@F7y6u_52tMf;RzV~$VinaC;dwyG z4*|~lcj)#e#qI#r0b!cUYfwyHjM@W~E zS8V$aMYG!jgAH=yBWNZ;k>ZEz#PICJqb}S)aJKicr-hm;g#QD2z-BPQ{_ifGhyvNv zRzZQC_w(1tHaY^cHwke&N+QI+d-0^CkBErqrCVVr&{xYYoq@iM5CWq1XW>C7o;88M zQ}bI4IE2jklxN#aD&7SG9&bqTtJ-K75_qD3LgscAU4S69hF`h{cEyEQR8#@WU==<6 z#bIi%QSzmZj(~b-_5|#s-;0Whz~`rmIui9(YYn{Dx1V}L$)!&XnG9X*EzK%Zw4qG~ zWJtSU9W3|a0{1+Sl5?{oXc3Ked;jHSJU(A(D;cW4tO$e4JbTKzSWAjN(iRYnMdB`z z4z!`yL()7fVjhc=Q}Tm;&sq9Mvu9#tTLZ73BZagA$HvAe(6PN>P<(v+f0sN9#%mZ* znwVQ+j`Z_~zAgymAEuA}p0#KzVE5}_lZ8yNZMCXwW$cyz%lX=z@J3cQ?0LWT#+Q4M z?j_ssSey7YD>9!Gv2n8az0v-rhn0^nW_)byzx&+?2qhR`J5WhlK0b3a{#pa4Vj1GU zC(9e6y9TTINLCoxddkWDk|bO9Jt{TP?Nelj3x zJ(ZYNWV4p;&i^hP141lz+_7&%Wik^dZv=r`%{Wm~(U0Bt)ITiS_74;Qqz>1+D@LVe zp&F*@rD3*)avGQfY4XPzal_vlFq2CuGP5)JvobT)aG+10KK-}4cM1)v;|;4*ehXoZzdD?cZ-`~BIV|{I9TB@O_O$zmsDgh zYG<8@Z7)pYcjP`3_1Ugz#=>gh_dg3V0G7WVJ$o3C7v(p55>c2Vd zZlHCv(7rdiV)V<-Kn!wPL9<$Jj?1UZU3%8_SyoW#yeG^%yV@mG@NVVzWWf^(_U*tg zU(lGDyr=en!-3r2XN3s=^q6*@x-{?J>I|3dr30A^C$6U9za$^g8f2R#>E{Nl#ia3G z_7EFy3!}e%opq^L@;+!`7AU(j{V%wFd46UJCj{A#ogmCHb^gEuK5uG+DrxNVyKk`Mn;M@`ZWIJCU4M(~l{pJvKo^f*MTKrw zi)OR}gQf`_iK|J^pHDiLaNcT@cx_1lExX5dDhNG&Mjg_v{ynFZ}#D;QDc)`Yi`70(^@v9FRdRLs+oP;ngbt|8W7Lr5LDn!i|@Eacq^vU=Qu# z`(Yy=*PSYK@2O=HCTtRx`pc{7RDJmN=%JoMoS&NKeX=#&ze;fU)*MB+mDkt#;)j2- z2o@0`r-rcvx*&$@3*=D|y2=!BPRT>JpRqZ)K`rNcY+{9Ox>CGnB|jv)PT;oOP5m^9 z*Y{=?$aJzm9i!^=Jf%r9NAn@RcM@H(wz$-R)3s=qWs5kAU;{oE`QvR_CxhR=*&qZc zv!5n#>=lpXw*Bw9e8G&R6@Bt9iY?|YpTAvD$B#3Mw*!5bXIa<*gklMpw77R@ndZZ^ zYpZ43mbD^OrPj#)!!Y zB@SqL*scg4CEK(wcTcllkWD{ImO2*Oxb~~Il4fV9B$k)5_PmJM5iFzC4waAKhQl$6 zF6y;`UH56_oB}4vBXzPz>VTGqj!dRg(R)Km^tR3`_-m^N*uy> zWnP4K`d0KQiR^Xb4iEt4UqL|5(c&h`@A$KDta^Mw2KF3 z{)Atjj7EB+WgGqZ0e1@w$w#=+C;x0Tc`sm$9NXJUnIP!5(i=?)+p0?Z zc{BKq0ml@snW|j(bh~?aT);={gbbpY=Sc1!%Z6+%HtSomF2L@7k+9erYUKN^E)>ALJ&{WAaQffja%krRL2MEk1KQ| z9h147^F{`j3XK_n7-?AJ3cEFP04ep=SI1kE`eYnxnGO~f*&qH|Cwu}T#HaBbIz@C~ zc1`cRe8d&oB}13LS#-6`QAD4^{lZ_m=*34SN2h*$tM2|~OutlQ4?1(D+!T4o9QyY2 zEC#pS=L~c5P!L*7FL8qxGZEQSZEO*(lV;D=T<+CYNK4#{?L6(Q0GI4l9 z?YKMZLwOm>ttxt1KRS>ua8oWpE(g{t*&`T&QYmJA=^4^%2&4TEDTTsVD zjVUZwXYSZ5q7gq%f3DMuV+w<-IPhmBs`o9%Y)Uv%HtHMuLuW9RR%&Qy- zUj>ISU`n{+RjE`klS7L3nSTOqhavWU9dYGK^WS2)4DVNGecYMP=+(36E6oV+;*omr z5D{Ei@A>`!u(ymxY&p!AM7b&;@$o})O4C*D(yt~3wYm!&;mOaUu z)1RqY%9H*BaHmZ{hrNY{j;;?Vg;m=(*C(<$hlhtsN+MDRQue?`>rSrC+M*L0_mzuS zW2<1gD8uKbar|EQ@WI9)xS@B$SM0yOBhmTBy?p z>-7zBkRO^x$}eX_0gi37i@cVtdwMR9L^^5Y0Bu?ex_$4-mKtxf3wU{nRO&?p|Edr( z4d7^>Wg%|bZ)CP17KXs8+E{1mXg{JkMuoq9OgVfWt^*7M82_xGI{Of>1+ud*Pe_>m zw)w{r{cXSgeuPAOmW$XD?Koo~TO$xqLajG7^5&tFsiByv}MLq5D%M&eB~r5|X1C!+3$bjB#L!PAzb zS*GiKW2-eU({?InT?MZ<4>&CgF&BZsnLU7u#sNrJ?*>k&)r9!?{i?a4PfZJ-PR;=c zLiKX+&k{}|U)izkXMM?;C#HHGy;9edSPF~s$`Y7tf>nMv;!((+HN?RW3YiB<(g(t1 zZ}2enn)hsC(-YMtyu@U2nq#DO(>Eo-ab5vA13!_&^BWQGR6M5Jlln_+LV_Z2ACbuF zIk_2FD_~j^N;`v@H8Z9cX|E!wh@a?GY%8JhKW;f1pJ-{uoXS&ZI7eN}h$X=o{X32r z=(f=JaBsF6Xh)1t$&~S`3UzZkqu;Q%9fEBSvIeL)4mlMWVP$K@FqZ4&;|?GH5l^OY z(JFro&-|dZ)8N-%Pg?4`V#~P1$U-DdV=GfABAG4ar)=!S1rhGD+2x^WOLNOug|)id z>n7xcaqaNXBrjr86@29vFIaMHn;HO-4xdKEPM1kWCS570?d!HI`!_|I7VCY$F5yot zEgi7b@Z(f$D^+pCUrGuZ6dP#*0HdoG6GcK092q&l(b_!MT<8XS34sX>c|b z;t-2l#UATd_tEV50n?bp$;D9cH-`E7`Sh`^=Ta>wn*ZKkIN*@Fv}tKf=kp)gT6R>q z(`|=cT~T4~b=%7SYYz!jvx#&FT3{r2F}oPYr}$VI?odOvk(&J zBT+;l+M^ozAqE`jv(xctXVI{E;~;P066X#v{!+azrI(4^D1mVJG7DKD?u%Bq)UyrC z*TiX(&=V|sae9(!V_VEWhIgGk0(kkV5<+YJd+}_dBe1x}hq3slm&B0-L0@jrUATU421eawvdf`h zDsTyY79OvWwP-%VDtK-Ft?T7eHf2?x2FHhTDSuBhly>u>e@i4hulnojk1CwTP4r~` zcd<6Rytb1xz?3&3qi2{fg#^w|GOB-c=xo_jB z?fBQhywCoDf7X9pi{;Oo1E*-r{T*y(r}d3O&f_2SM))!c>YSq_O-=?HexM za(HLxoJG~w{_(2LAChs|+1a}taUNzQd%L?N@)4fkP{@*xXdkidu`GjwxH9tI^m>C? z>!+3e$8q<@oo3bGOiyd>ib(ry8PkaZpV5$rF2gaCD;Zt$xDwTs~M-bnK#b2H-nQ8P z>U}SMl{J}o*s*liFaXaf;6^6M$Iriu`tWNM$cu@r`g#fy9iCN+9-ukvSY}pq6@H8E z_Loe=w8byfTHk)L1&6gi?l%b)u|N1G7t#15)XGI_N*aT0p=HB8AD4nNru&#J{bKJy z3X(URUgC2!I7SdTu-2acQ{h zU9uM>MfflY=j4Sgx#LTw>x5&MnXp*)Mhdl`Gj%;hVvCM2ZMF!)FpP31io`?`m&2z0 zzMmNqsC8zXtGiPh3cb!IFR;5a`?915n3;Ian{2zSgInqADl+5UeD@xbc+;g_Wg@JY z=)OeT?kGvoXdf$d<8n-3?~4XSyw^L)*U6+vj>n?V9$D;58Z81wj<%o`pI!%Hg1i7) zx;c&FYrx@tnT;bK(P*3DWeJ?PNt*|P##jnTKi5ByFSMTtcf7y4535@ADye159HRT- zPvGn+OGma4+++uR#>7#vw-i-CBU{54i6&mb4}YxY&YiFUJEs)2dTSP+=w4TkuL1C> zn{wV^wEw-7U?L10=2X7o#t#~Q_)HPNN#Vd7F6Gwb4T&WN=10M02>KPG<59y5Q~C0z zjtJkS;E~XdLWCP$RfS+HH zFR@p?+X@!eGgX>b6zMK?CAH7UV1r`)B~0Rcs7kfBdBAel9RZzl>^jRD(vt^d2F zIciz*6U5BeiHVQn2L_Ccpugx&;U@ZX;Thf&wxrR`4JSUpOL_P?Kg(ko-4S`>N(zN@`$Ea*BW}1zAKD<9pv=bH z*SK=oEo*!gN^B}jdmNir&{STaEiV6~md}P0$wXaJB&ByZ?NGg?*n$S%(u1Uj8U18q z7OTSjMqVkL@TN1a5{42dEqp|TPQPuSSUys4$-cUC-&gvuzpI_2eYi;y-FQhP!xwZF$ z{rLiSKslnSe)-RZ*}IV-`OsPKi=1^%6v?=210IuC(y_-x=?KiJy}W&}_kDMfch*Wq-KNWBon=_7 zplDn#?~5-J-aCZo-GG#e939p9uhYM-mruw1`%USNC*S-LRY*F0(^5vAc3t+>P37cp zZBRY?q5~EtP1AItUQ!|Do>BUv6cH>IPS&eLq15<{qt_tB^{mUqpHk*$=hCvXbDvEo zOSakjj_}8+Z%9@t3cK`#RH*?eAwhOxN_)rxf0Gc9;J$ zH*-|W^nRV}Ea!y*x(auGz4)fx&4Fm}e^oeyT6?87Az5?BiFnVTh=iN3JV_deMZ8PhH+-*Hwb&h_ z`spR#eKg>RyB-^rZ+@9L7?i9iJhGPiP#w8`Px%A2%qc3^5ZH)xCDzjC6;u2>jQU~R zCpt?X%y%@Q>Rz z)Yti?ggNj|U(yP}Fr@sbU zmL?IRFkpho>PIJe9BK#RD!)LNvo}Y2R?QE*mP{j_YnGWxzp&hBpHu0$JK8ip{@MbF za#`eny~}@}%X$$qi&yKkZMGV@E5`r(E7lsTAyO9|k8LT>}$^24Z!Yj9x5 z1CnEs<{^)Zxgmmx*^JS(?a7~!&bem6GZ zOGOaJD|u#wFkSUJzozF&{WO4XXIVpHff!NkzcXa>E(wVoFnM(3(Jy`TYi8tACJBp| z+iTrF+hl0%^6+sBmv6D*-a=BV3`fjDz+V>FfbsC?7b%V%Zv6_GQ7>eA)uOb_0-NPk zT12?c4Mx)|ZO+tp5uiW>%YReg@f=XmLFMPG3hE`w;zUM6SYPs;n4bRn`%qCVq&1+T zaG~@mIro(B-`ZI5h#IY~7`CwKvIv86%I(+hFx6LTC`e+$m~^lo4qEoO-_#)HwgGpf zvnN&5YQ-k=cFG*Nk38y+ja|r5NHmPZ&>($77ZJ~sjd4igibgv;|>Ci7l8CLDa6`vngUpzR;1&Rp>q&hg-z0Z@;d0bSvG&YQF zSUU6F{2m6?^N!xKJIB19Yry<{0}xkn`R&F^>}J3Jci%2sS2BDlw&q@~D(ecR)fLp3 za^Acr(SydFuuQiSVhn3fx_N+`k}j}kRGBXB=ui$JiOcXGDJ4%l*752cb-ETo3-qDY zd${dhk2Wp~IWZ~r19Q)DpjxiQC+A`TOp619U-|znGh%94KPgZzG*md=!2E4equ#UM zJ}BDkmfo_=G8f{#e06awhVHuKpTLnU9Hb%+R=Xrc4Ss*7>n|znK0gXW2%h&4!(TOH zyZpLmd5zm6`=;6)*xc6xaMhAQ#EuG>7T>-!Ms7fM>$!O#e-WYr$B_8EU26QA(f_iP zOYV`n5iT&$N6U2bZPb;dEbh`*g<)y&b~YBTn&H;=G8aF7IR0}fI+{UveLMfB|6q>l zN=}B~7f{e$rHB-XS`B)(FXH+mr#wkK4TfB)<|*}2r!B~^f|xv{y&<&GOVg?ZF|uz9TFlS zEg=dB5>ir<(%ndhAYFn2(g;X{l!Qo0cb7;iA|=uw4bt#EYro$)KlYDv?TbCGPs_WoRD`A)3uMv8J@e7R*t zGT$VzuG`t02`)t}OhEaYd+_pavdX{hSxyurL(Je<0?Lp6ZNfz5$yp0NnUA2)K#l)K z8u(<3uo)9%Wo9NvO2aHefZPuRu2Z`S?;Yg7z`m>nYVLf+OJp)$iQopQ3N&neR%O~_ z4_BU^R3_}h|DKk!5nHY#y zxDV+6>G+jvqJSAfjh7?Br1;a9)@z%hN&l!h7mxC54CeE(ynfEcK}dgt_zc?GpY^_% zD}EHH`e*b)$^L?r7GHuYk}xz@`=~0m-bpf0SJDi(ve%$%QqjFqXD|Md)@L2HNB4ap zWCZ~WxV7Bx*?+eRm~NRKFJ3gJp3?2s?O}s!10{tTMe2x8M%5f$ zbL}q5I-fEVC4QN>eaFoaDcw&KI`QrIm;NTXT<^nb=J-MKwNX*~stPUxBFlFl2M)@X z;PLzQgLp2H9J`nw_uU6O7bT6VZ!>z;4JM9;h>)OahT`1|h?)CYWZp{$5L7$JqZO3D zVG`oI+m6NKhAd_h>;(WqQmj$r`qPB>uiJ|k!Mz@xB!I^+Flm3a8bX9aBVezJfjo~$ zJ6QOX5#;|w7Bq`7QGAF~Jf3Km-X0*;eY`8PRACqESYx1G_2hfR?goKaKs=miUeMzJ zmgJ;IS2+XuoL^Z_N)YGYp;DI4e!H*-oxwk1wHdiz>kUqNoB2jrCTk%1lvv55inV){ z{fAKao>}SKntsbzGzg1)KL`84P&5DmzrnzxX!^p3Y^yWhfd*B^U?S(_VuPu?qN3tk zGIrO|`FUgaR&|J%f*^x#3v%_-qjN7mYukuh*-P}f<-y^+;KKV!6FK9KLOZ+9vp!SQ zi4pi3kFq7n$r@P@K>ZQ4KK}98u*O0ymt{!LAiaK&Vd(e~9jPFrW3OZ?O3Gmy&ILpt#$@H?b9-HpK zqv&QuLa%n@{o(L+eWIHB!9N>+%YSbMp*g+W{IOLX5CAX^D`56Mu$_4L9DtR~1y9fR zsw&BC-}pEF;;#N`f``dX{O7Nd+|%!RGIs(9n66o3MH+lp&YoJy@jn-QYVZZiHhLn$ z+gwJkuKiJ|`{obxV5nm$pEZK!KwxO5;Pl8lPkC9SO9SzXnx~??$|^($xoj za|LVCIg%SmT|^b|m~1ff`Y$FCdocs#4g#FPYIf^&@A0RHF5#Gyx`HW_8!8l0@8IcXeo zLajgpvrQ}$Ks7T!O}$4LRc*PFMW`pCfvv{3I`c7o46Je;N~Pv1UMJMHkfv`thmESnp7-jsRIj+iER!RkR5 zvy?gqA2Zz;zFszO>Meh8*|iFpaFbIG4k5F!C!uY`J$NZ`Tra#ZtKww)P&rH3I!nqd z;|V?MQ2OaX466!l)ja61$$_wEFajh$t)RvzGnguR^nr8W1?bF$5&by>{~dZ?*ueDw zE*%x9+K>9@=KNcU7(p>B4VK7{$zeTS_8Q)jAw&)^sH-)N9-QgM4FSgeDkTgD4Gg?R z`(D$Xve0FfO%r`|#Cf|~O~1J#e!d10RXerRP2phUilWo_k_(om=L9DNChZrebk{%Y zD%#7wn+z&v%T&>!cp(_k6dm8BY&B!p#*d|=`yAz)#SckY&%4rH5*AI- zo1?-mf2a!*9@soya~@nzGWu2fa}V-|QwHzC$61he#Y*BfL~Vmo>2#x{ED&oP2ib`^ zg+s1Iy&Zxb852{6r-4~sQ86_QGVSA_qM)`QrIs+M0EVV0$#4;uKhL%%SDl{K%P;=u z4eK|2oJ_xcUDov4jfgHdy_VE;UHvcP$`^7tyT?}F(!B!S^a<)hS+#R50?GzrJ2PIy z<=C*1YiWl+{}w2C8cI)}etyA!m^zgC&XjL^P82Vse4?Pn|G7o|<5U6)Ev+{fr!(vZ zKlP1k3x_1Iu+B3eK9WL;y;Up7@v7P9nAd%S4AIfi!KPFG`*L@W1DWNnUW1gju=@sR zyZ(OmeinY<*FbGCiin6P`TO@TG#4H}K)e3mMU}lZKze{yQ-rDw;m_r8O)Z3|2n7Wt zfQ5xQ%c$8)Eyde1mR>^=I~SM1DfhhBAe6QO*G1^Z>y7HcVZ(agehh{#ePXd&{6LI2 z7YF%RDp}cHt~Lsjo=!_vMRY8zNdf|bYK5myyPiKVGdGvY6!AJlDr8#N*){H*RdX7& zzFfYtgP#Pq4MKg9X339BB&Pf1S3(RjRFDBCFc;Dbq3G(LKk=vCrWN3_HRv7`%FPxQh5? zD=M?y_RY)lTWZy8W8c->yS?o?Lzyr95fv+J32erev!PKNWh9b$NPn`cuDebp9Gb-< z|4yN~VhE{27LQch!fmMbAqpnKn%zu^UI<&&C}r zn7X88A)S>pS@RfS?{XO7zf(4eWl<+szjKE6l~@y{sU&ELOGrk}9}YolSM z@!OdB@o;mO#@5zW0MccJ&vGCyLYA9n`)5Tk9G=2pC^GQkya~R0icaz)q*li|D(`uuge$}m? zZD^L%tPF1Ympmy=T>(gPJ{aHi#q!5~0<30?_>~Tw22?U7fq{q+A{z+k(^lqbi(RQl zc)ptnk`Dq1LnPol&{%AF^V{#oLtQ!vnn5g2lOF^0{+oc!SYBv^^=t9oQt=gy z(uaKSt2W*q{Rkmc)Ty8(_M~l6NHR3&E$bm+kluhaVFS|^4z}frOiza#pW|)ex@&T? z!{g&x4Vi+bZ-A588CJ$H;iWocl8ydCch4;3H0}DbY&+wT+U&RVNBWB!)vBwFqoX>H zrWUnk6e$XI^p-d@LkyU4P2Z2-WS2-ClB+^zj{`l)8|>AD-@#FZqZCSx$&q~T14Hvs>&dJrtZx7H^};h zxNfPfP~0Y+)2F{%Aydx>uxYI#i`HWZi1oHTFO2o#mbnd8{0yJS#oZijPx$OG$X!cg zjTQ92$i<6HhixtFeB%1KpvQyF~ACg5Vf%F_Is;FoMLowM(1X zY~KRYCsvhI4MFyMMdyF#1BzY>3iR;HUKx6Xr6yefKG>Xg~+3YlXuWgKw z7}e(;azzrckW0=b?=m1nT|0!k;?YKmrKU+|8~y)%jB>ak1?;;b-Kqk(>_r-QVf#-~ zfRYB1;j|*2v2eN9wx#DPgaZB<7_wTgk_Xt&O?Vu)`*j;Ckk|M*J!U;Mx>nBl?bFgR zFn7b|fvG^sHsM>6vQguHtRQJK0o#COx|tVhCzr)Jp5woMF1yBQ4`&X$SX@hpS4~~y zH)j|Q!38q3|Mf}t5PrW%Sks_tL;zO#TFKd&7Xc>p3ZUJ!GE$UAK$sa#5jDWLwe`ij z1S%Wp6O$o^u8~C5ueEbUuK92Me!-~wBV5p%5Q{hpYk!K{ps1lpdoh9SZH)bNO%#%1 zn;@L`Ww!o>c1Gi<$9sB0v3tLtK9|ch*hz}34*f^ck`)m0ti4GxmDwtHuNt3jnB>V* zOeV-vkZjCB zzhNT}np65l*JWH_cJypb*U(Kj`*<8y;CWCR;ww@p`NdIC+%&G`2x)3rkizOMyM4|> z!PsBiCqpS)@-l)FD}5W>#-Iz+#>hwQyN^Yb!NI-k{_;;34x;6Bg(fcnY&>RN|0Y)) zeFn0-^Ypi^w3oMpbOcl`2P%gK`X}gSW$VcI+7gmJM{RmaN%oF+gt5;CPFWN@)}&88 zB_u7SxD5M{U6Nk)-1NwO6YY3DA}V9#gWtI%oatKB|Fq4(9&ZEv8N39$K^-rWGYdA_ zVGB|#tTI!AP&pXTJ?)dQ?M@k*n z>fL%2;jI8l>90?i*5%pj$Pe;H6P%>Sb)_srUQ2w&HJDu8jmz#l|F?Z<1!5_$1s&!- zp*g>JkqeF!8`8+9ULVcH0wLY(rzw@;op11su0~n2GSgcpUzJf>hY)4pGL#vfj7Z2m ztc(!<<0>gp+^k)H4HmACl(6GmFVEaHRo}vsr|lq(>wJ%AJrJ;4t6mFV?Crg%_tPIa zD@|*p+Hc$)O((9L``OY_VPZ7)?%DSIiAq!V)>X>RJlu6Td1m8o59zA(V-xCnxZF1!6R3*|f85$uC6ppw1PeJjs z6NdLi+B=sAAg5u+YT7>&=p|-CLi)=(5=ZUXVaxu)q5^v5CT-WL4~AE(a_Ln>fc^tR zY|~`0;RRDu_1F0qoW&T@UR+4qlR%LFM|J+)7G$O`;CSY;7ay4D6HULzKGzawe>SKp zQv9BhC0LEd;3}!sQ^bzwUcpTwN!0>F^HH<*=XVvn`lMK6j&9VGxPEfj6c~ctk|he5 zUfyZB*jLnaew!mwg+$}P|FQ9-)T703I%Yax=JP>+eIwV2Fv66VkyuYgyE>#Pb%E)Q z2$OFYMYiKs>Lu`I92$r^fU2tk(MSXKC8@S3YDQkraV-sJ(X%r*9{;WQS#2IVzowSk zL;ukC=i~q!JJANctX_0>me9{$Js zyQy>M*H=#a!{Z<4od{quf)ArZE#&9WzqVlF;vFBF_f+?SeF*A$f8RYS{jY?XNHF zu-(N1;7r~KebDB$)AtQcL&qLzq4y5sa%cWO40ME+h~DHSgmR1zwBj*Zy~D8)cvdN6 zxM0+B2kYY%i^taNLKLow8$Qgf%dnVz^GxxkzuP>?5{Pn-A zSu=!~!rl%7h7@`7epV5;&H$$!7>A-`Vxsc)&d-}azP>U~;xZPv-9Fb*Kbi-HQ48Jc zxgNc0Z;Kb$D5d;e4948l%2aG~=V$lpum8%gf_M;mG_9D~*KpF_15}Wsie-ORP$&sc znqm>n1m266RpP$lb!t!`QebAf@YSSncZJ)@jbMIMENZZ5UfX2|p%8n@veaZ4cH=%T z4eda_|EbJmOUeR>Ug;kGoqG1aZ#!MXW$brEuCCw*0`rQIG=kf`qFDcGD@s*0{7(*Q z$vkV*c`Z_A75cAkn+c@y=F_l^Z=;Pat?pPf1!I)__;l-`=WcEAN2LrcqA&M^kdDO| zFx0)^)FhU=LkQ9DR5?%J)>?1eY0csY;r;uo8X$WolK=OtR!A2l1cXWq6Ob^XgGofRVJqoe z%`WSXVk^BjE)At@WRXqr_eG2lqQJv03)jR$iYS&#!a)y_rK`@+GjJfdtd%Ea)k2|y zEgS)jfX07MdJ2K)CU9;gu@8`;>D0Y-uGwKL?81~3QD2M`!ipWe&;vgx2JqtQbtCV~CNQSV{mj_-_Wvii8@`;zxml3$;YVoOv@ zWXM#v&@CsSH5y)l2eQkousaP3t*CbbU_eSbpo&PjxH{iC4#*VPS_Sp(@6`G&u1e$E z5x-j%dwWP@9aWzlSy}J)*&oG{n32YkUOj%0mUrJ+kt_b!er`c<5;xA;pM`~+_rTB) zisXD;C1g?b0z@_moSd8xFyIk=bK@qT)$p9C@l?{`mojn3z{5f#qdZn-rhJWsMdnZ< z8v%1U<$U{(RykLFWlN0G;4yE43@id^Sq@Mk z_w!Qy>+~w~-j~g}xl*A;IX=i_AcoML$f0G6jwFb}q9zCV#H~62 z3_`%pPg0@i9EQLOF#H;R2z$Uk;K(e5R#(3~(`dc=W1HVra7NIpL`fl{h{EjLMouwc zggWO{UlkUi=g5W&53!KL{ha!Qay7jZFjMKSIDPnvd(6q%V&5~LX*hLbr&J0EOV<4 zeamXCOOVsy=_#)EL%!3Gqgg}A_x!Sn{>*`{BEs3-9d@cP7ipT}(?@b|Mg32<&nwbu z?H$v!+GNiBrVSr14f|bR-5MyNksf=e&bI5QyKwCA1iPNJzD^;3APNBrPST(uswu%f zpbrx(bHvm1hs5ki$A?|m{vQL{@FhCbS>I7&EuMN>IylgQFCA(6DcybW_9`+y-a6WD z5Q9-#h5l-VK&7F)6vdpZq&+@8f-D0$Qcaj+o>0jBohv;k zlO?1-DTGzWU92Tg)DjIf5*vgGzSB*hlAr4dgG?>%Yz?WTVuEn6r;pA)IZ9YkCK*tNh;K=vR!I81=9)@V^$)B$)N;Jhso6{v}U)9!}ub2N75VGop zlVdTkpxE%id#LUb#acZ!3J{#{Lr6rZ6Gi-?#g~Fw`4O&DXo8v*H*!m1IMIZOsPsK@tw31MpADutyNd&dd&a+SI|7$k2_webe!vh{9&eN-wNh zmVuEX#dhRJru&aig6xqNemp6`gQV)Q?;Sh8mX17s6}477!L9U*Qut)3O-vL#gjGw- zdzBSKhzdZ%AMtx-r9fF7nccR)HWO9AX%4^b=RNb((D@r#UW3VNCyr$TW2J?meNBz^ z`_!SaT^3E7n&gR%HSzlYw%w*G{Ccx(o_(aiSR4OH_@3KP9U~tWB7h@VHiSPHCVq9Y zc#KTTQ86*Yzm_+6@G(2{!MVffwDG9gW*jpR$eXc1g?|LnDjQ-;(`AZ+SHC;wmAgHk z_=$81l#WWit6Aj6>$YP~V*V$(DOh(aB3@!R#+`q>jr>W zjZUQn4uW`L!K+|6`JU~;k1cvy0%5bQ?VJ}^b(IpwY8dkU7jjtoAsPI-Ptq>j+y0eM z32*P{_x!w3MNFa|cTYa7^S$XhgQ&jpruvZgdEVQWeC`Jh`|Y2cT28IPVHN`f%@pV@ zir%StF@W5|l_)Q5X^{CH-ii77>xv5F>OeLgX{(bH;K+*d7&koVd0upWn4v=5M?(Ld zcs;zoIB+h3lUnk2ephV#lSH0ryh&Wf(N>_?FRXZU+~s> z1m!FrUsnz@H*9-OPp~}u)IGuFd|3QLhVveOu4`Gqh!SU2$2Fh6+^yM{R*Ipc=oR68 z8wmi64!Hglj}KQ@QS(tY9ru+klW&vsGahf z19jO8DRTmINHp~U1H(riH@%N~j$YQ=oypA)r{bC0HZ*jera=W{b(lnPJv`?XDyvrQ za3OZT%1?0WP8zPf+*)&p5eB-Nuz>X2*W9mO@8cv{Eph2?h>Z4`(*dPfmJlfkvHv{jB5nQZc7$Js#8( z3d9C9+_nC8J&`vNf$*^tW)%fg6$G;$y5w9!p@x;!=v=>ZsKk1DT(djJ#gy&;rG<2s z8kHXnC5lAjBkCxdBD#FNNRA+GaHC(u*{pE?5w2Dx_RpEXSq!};M7TVrzYxgHP+|zN zr&V!Q+uCKME>QNg?)|N(o%7zjFDYkx-8qU-NIicdE&V(Hy^&dPtXjR_YjN*)uTAc4 zCjf9Q7dAeKz)VqZ5kG*3Y36B_SDb&<&fYtEvqTIUrjI`)NUD~^lG4a}G#}lwc~)gA z0f58{O z{kT&G*p1(^*^7y_w#+_8Z$%S;N!}4tj7YqCO)=C{VDw6CUw-e({Yn{|A`QiK=Gj13 zZ;njFug}-Evl=C-RE;eU!ZuJZ!g?1h{wzxPH%MShf5dC&qKT#G#2PUl6r|qj?hdBp z(sT0yWFZDDe`IxwlrV$$OrV4nMzlf34JIWaLFK0=Ai&1%lT%V6cqyDgt2%Zm0&Fop zhNXQ-lDliUF>|9%T4eO%mxrX-42*$jh#RU3tbeC#%LZX}_KTGz-|bggvX;~0C@nw2 zouBlhoq^$>4UGEHY--g<*w}oi)EI@52({h7S6Jw`ehURMA+-PT)T?Ew;>z*ee)c#? z@oFbdfkF+{J>s?&R%|?>!8ZiAC6U3m(OB?Fr3L9(||g*RUucqKN1Y=qfj5BE3JZCqOmx z?oEx|K>Rm)M&ds;zeabbdgXo<9elaX9x!(O^2&|2tp{jCNDL;pvk>1W3*JKjUXjiB z-<0)F@DRNQBT{2nX>LxyFQW-UwYqyt?^M2B@AcB_`-t2Mmi)jA9DNZMVd1mr?%pAh zy)M$_>sIFl$rP$7{f0nwTj)m3YXR3K;M^c$_=ogehsTz@mYTB>5na3_^V-In!igYE z!KcE67l(`&1c5OWBPC@#3Lm6H5^xAVVzIqM=~iyrKL-BU?2N#Xl_c3ba2{z>F*}hwC~qKS?|$ zyjoMDc-4LK5l9H=U?GY?xUEl|u5-F*YuTiJfABI*2<4Rmif()g!b>hY;gvQv+tdE8 z=t(i@gIGC5xJ~rNu=+0hDvaL~EH7hS4}IZcRb^$8Zt0I}kh&C?!e++|yt+J(c?2~O)APhh))lg;N(|GpcA7OUfc2tBi}a%ttEI_;X1tL&2}Y)#FF{S+^*t^h}t z53+hjNO-|)NNh-2Ei>5ZfP#hn<9o&EchMvE%AT=^iKQQyPVWdfq;BxCMQy$Lm#@&A zbad|dGt-p_wV$b@_T@vcoqeow_v%-#mc5T7j6t;L{ElZ|fxJH;{S&{c;`g9QcF(jz zReC525-R~iRxf@*&)&)!LZ$*0KY*BepmTu_(%j$-APs+ztdrILq!R=`#%%3YQ{u_b z26s+{*KL(!;-!u9>CZvgt`XM%40o8BWfYW^pV-=R;Nsyiyk!J{77pXQHN+t9A{o4gW1I+etkZS@4 z>8<}>^Kr@v7%Li9m9?DN_JDdYIavJp2LQdm4nStXusvUdZAw@c6(!oG2%W!XnCf)I02;>{7nG4}zIKSut0`O4O2-^A8u zzfe$%9#FYV(|&zOcrQU+RZTk0C0M?o7qfOvSIlxCK>z{o#e0hg{PA+!@F6%1uAS#l+_D5Q|iQ(=RQeryC*MtADsD}0dH6&wm<1KG=X(B zB9LeD(|S_M`|)b;MyoG+(=5`i^(iMN2_a@v8HM8Ik49f(EzES|<+8L2)!#xqO??o4 zGpxNZXK5MWf0P-bJ}*70^_rtsy@UbM0uqjKt)D^T2Q>05-k9-HX+8`5JKK2tX3|pL zB0>EK0{SJmg+1+jb0dQ4zPDShk*K$TJ>B<8Q;l&ef;3RED|Z;wBJgqBoOA9fUm(CF zpe564_I97YK5xA~sM5LHBj$HDQ$7dPPSxn1px0hEB?~o$m16H zQO(WGLR@lt-JUATJEkPYwfo$}r;BV6Bkp!&oe7a#K}lgkeE2QGy`;Bq+CSK;^Sp-k zbnB$-tqgsDI=YEXR&SOnIy#mvBzvR7KBgG5q{}O?faQf?EueRWi0DQIXgH$nP1$7a zAp4gupT3uJ5!kDTGH2d*%>E={x@D9hH}fqxEJlU4{FAuOf1oZD&wfOl!EHs`vy+{GivFB0 zk8tS4)Py0?Tx`xJn?FW(cHadF-o z1i%D&QNsP(fSbJw&X6H0VyEZ`z!B4A&;+lim|qG9A|o%mAC(o)K)v!YX0n9?hq%kJ1O0+A-*fQpFpJzWm8ic0%(b@a2s(&pxR zYw5+=prG3G|Jrbboq&&75Bca=6#=WUuv^3Dt-It zXxb@_rFCy58%Q0($?6;l;W41m8|qJVdE9!9fjHcmEVD6H8&&N$j`6;1Ac+~mVG*UO z4OYkPUz9j7z3l7$Vn>ATzfWoGtA>VvG}npWWuoEAqMVM6_*v_ewZ1l*`|i);VlMcc zl`mHfi%nyf8z^7~yZBsB zy<*ortyi%mOExXm4i=!D2$puU!;{DlTq0(O7&GMDQefxOB}92Bfndds6=jSk%*uIR zyTz39kw;>XbEFW)s^E35pLc&Pciw9?!$2}jhvNFIe7wayts+GxiTo<2wxG0ERMtSI z+x}nh-pAF90mV@I-d2?oAx{$GTXTMwg7bgPlT3Lz1kHOQ+umFv*qh< zh`q_l4+DwJ!0J;Ln3TyMs3Jqdz<{`wz=TDC<)IatrxWy|wVxyp%Z3AyVEE-faN0B< z0f1Nl>))2K*7K?>?-f0$$XSTL?2Ogkb3QuHvx@nb9gki+gfhj1YMHa($W~E#r25#^ z=Xb@U+YyW%k7VL{#Z%s(WWiG&*+;zFqnr+?zuHuyG#mD71)*sa{Tj#biQzG@rWSV# zb^zq7<+Z>wy9Z2M&bd~#HPUVmA#YqT-+7Nkfc26U@|2Xnvg0vKySF|w803H9^5oDvl0^%#Q^s~5JGegY_owbtl;(&sVjaISHR04n4=;PCR1bi zaZWHj5EB)>Jo(|*nCXh{Gs;TQ{Q4Gsi}J;WOq*qugj>B68QyVNB`tBbbYz&aU{hzX zT(1pJ?tJmJ>W-Fsg~K(^)+&$A?pD%{U@OS~w;~jZMhexKkOjd9>c=n{MMM0ZJ5qcW zQO(AYCxf=3U5j}qrtcefkFoINom#99boy;nYIM5wLbwKJ(0Ztn8 zaTO^6hs%X)*Q(0eyM~o{^vDhQ(TB#9D+v8TlYdBmb+20Id^4vDU)nFfAF=oT1F}Re zJn)qD=Hi^a(;zC!mhWwK6Ekrl~=x+2Lz*uLh1>A0i5hkz;{4f9Q zhUcYqm51QHYV)OGGDj6`wTmz(6cjw5k2@Gu!fiifM0&Z`& z84AwgupLJc@zb3hWmEy1Gw}wF6Mv_Ih@9x6Z$0|ad`zlxg4$L)?>~tA`XnpgG9o68 zd#Wm&2gkV; zcCBZ&L7Fm5-d{82=)IhP7BX;7VSA*K!K}az51%e6p%>*t5#xV|S$&hNAtcXk-mlSR z{C)0|n18yh{-R)kc=DJq6PCsZ#2;>>&z5@+2^Q#b*%oj%y}zAI_r>G;#o{n@*lve9{2Z_i9W<|=#f?{o^{ywr;D>Oj0fT%^q zXMv3{0a)*m|F6^Wzi6XatGdmJhv70#AD&DKbQ#(=+G&<RZH{ z&yn0B@@;Y(HD6~hqM;A?DQ4#TGz;9S#1zb(Qd!HpS1@a;t~MuYJ81 zO^|u#0jkCNSpIV2XK)Oi+J);q?eX_)o+?X=;CWX5{V;7EUg?jUZpTV^KMee_NQ3+0#+y?;;-2M5&a;Yq$mcA8v7Ai1FPe#dl(-_uU5e#M1_Yp-E+ z2a;}cBIJl4WyZtEiihJpA_XWD0MA4qVDTrlw6NBxzrvkt{AhnK`b+Q3Bu<&SB=_J^ z;VT1521YVHavMP#DhH7qdhYJtBN2MiM$@0W3oW4M(E-lqx9ZxZ*pG(3eRX_!?}*yg z?YYDqK}9j^nNd&FG9scMEka5|{f7s2Gu4P}=)1l?#P4bC0wu!%sj?@LRHME20>hjf z9B;1yE2T{;Y5(aDIebkw)H}k$)KJ@^BEXHk%?EfvimTko+KrC$+=p?;J;YN?TH&!J zt&E^!8Y_d7E_r+C34S&~=y7-VNnJ0uaox#K&DOLZ%tW4nPxwU;wFu}v;wa0@JAU3f zmQWq{*3^^Zy)l4LT!DXJL)XRe{|{;&9Ea=#M&M&!5Aw7|UY(^K#Y}oPk#6nJc}mKxdmry% z^##Q<<20#Dq_&P^33#>$avRhi{_HuL|MW4zJBnWX7A*Zr_s{FW-i0K{Ygg5zVsL7p zR*MS1ou!WiuhnekW+fX#wi*{z3DzG~H@B1N`&NZ0zrke>`7!+p>{k|na_bL{1?g_! z&q@L8xv7hzNnLhtYiXk)^lBZ4;2_S(g8ghbIGMjvR{+PB2fPdn3o?lc)jI*# z=ku@*Q#Di+5$maxXhyR?cQCSwIi zGjojynCdVNR>k+ALm@;U-t}uNAG^Rf(H#{H^}L=8T|#Mtq@Sq*p3P9m1A>^TLuzaZ zyZkPnXSKN!&dtd4L6{Gfdmq^%+Cp$hh0}&s@?i`m0#!&EHbXQlC$iy3fc_e;Jx*+; zK`4aH@#OUMrmczmgEg@O@*Kj$;Jf{VQMn4tH}%AsY{ZXbigEUi&!M9!F*7rxMzlfm zTYT8!_u!bx{qO0EC+5|UJwrnSE0It1$m!0B;3tCW_qXKx3|& z5Fl)A83n7z7H7!(NFtnIH28RJL1OBM*-1(q75wcHxnP(`*yMo*-NdvQ{;V(tct`*tIjl7lf5RI-uYQIBA%j-JPjFYxU85+NqajI(aOX|D@K9!aOxO98fgDv}c zLt_5`S>^u@JnQ3MH4b`+wxewP_n!OzW)lX2yA2W3s_Jf!I^yWw&^lTzqWZo@{< zSy_w0qa^hKr(a)irlzLgp&*9qegrr-TA?1!yxxaTr?(fk@jT=u9|!B*;paqyl5|6k zou7A*m+CmFk|PR;zxKKY22CT5wFe+?kTD4(j(O0tKsyBZ{(r>}H;Ot%>H#ca7J*AN ze9^SITFx?jnB(uxbgQ^2W?I7XX2WA~b*H|?I%;|+?~Q)eYcvGlU^N|$#f&fO_hFKQ z+1!s^wh@%g2P4$Rh`R&3rF5A2K-&rlX*gIJp5!ZmXF;A{1VXFKXp0iEh%JEAqoC9C zt%mB=9S!To9T=3DJb}4HqDo-G>lFjVr-!H8jXMPcdd#Uec2w@XKmR~UA3~&>0^@p! z+cyc`+WsbgvGO+=6vVhST>_f$-}J>&o6>!e@K=5QJ(~{?$7;r}eVdLNJ!%whZ*Q+% z+;RT1nU*QNxETVG!v zP8V_Ks5~wA*I3*fihnmKjjhn3FwtU^clEnBHu2ro`8P;ssK^LWLUQg52M*CT+8HYU z^25!RxDN@5^OiHDD3a_CgF-)hBT8qpjcUWncW)yv*Y*pbDIu5r2wu~UkU1eCp#%8e zJ6OdYlQVQd>23dCg(QR_2bNT9`C(DvN20EO*EC+&-XO^IkL=6oOCR6F&CBagm3*xF zu3@4~m(G9nAAOoC$W&;3DkN!COce^dU65ssjw#AB7u0-$~(**Ug0wo$ND$GUhdq5#h zm{w&VSu$7%5Uq%BLWWnNLQBE-Zm2o=7o=OMu^mn(&rw|Doy2>DZl@Z8Gah zn;4JT?+~37`Z!+ZrwrxSTdX1pb9K=i zUYV+E!Ah#@50KU9GrN(hbpiMWu_-Cxz}NckC!1D?KTK3Fazpw?7nPMc^}y|kf(qcC z6tWoLe2g#wO`tpc{MF|$_Zz+JoD5sCs;93FPVg*M-KfU4nIkiYaW4qUJ zAET}JWLsGIle$=UYML>gP6;w*2JH~3?4A(i0=?%uH27%4a1eHB2~lr1KP2^e@yEHC zmr_8tMIuC1wNE+q3#9_$4 zWcr>Iu{PtGUcJ)EJ*cS{qRJsaBmz@i^_IvpmK8()*-D{JSAuB{1q`-QRabv}ZqW=C%07d8TdDcTMvfJpt z5XRJFpIT}aKG33Mk3|q7Mr^9DT2KlQ`R_B;>o<-)7;fKAK$VXA;ZOX$;Fz1h{A@fI zI~+CW*KPb8cCULcq++cHd#?G+_LMek>=hn`<|aM$w0X7XtApppn|eENj>wEz?Pic3 zsqOP-#jCbW)n|4g^1p8f&AHlnA>_Mt!@foJwl_)Bau`M@za!o$XZp%X#xwCehys(| zS+g014TH>^3%!~|p;{O}Fx60$D)P}{Y3&>;0!B}s^e`$K0=y+L>S`Qd9rI2Qpu$hMe4 z>J0(`+x2k<78a|*S;rVdNbvTOVGdANdcuA&w zk8E|pK#hCjX6MLUEp@`lVxF5C=7yKH)H5ei60YzQp+_iFIrtgbA#W+OR}xi8iCMqO zKeYY!B=!dugY8ayIafl6F%GVi^oH*T*?TvZ47%m*#G1YYVQczGp_~fb4@bw14t=Bj zc!)iFL6IUO8#Au-p>{&(Q(|8B?;|+4eT5CZVMM43>~1YjmUO?$$tzo_Slx^iXMjj> zaSghyf=${iVvvF|dY}-Z*D2N7dNC||yq+5)=Ish!=&3I+Rb(;KV_2c}8a6pE*yzR+ z{j9seDSGz)NLF5jNU9viTb!OpzoK;Z@?>@_lS?FDgP6>%xo`ybKi6Z&Tvm9r+>~T` z1iOK>w$aYz4f`%4;>7*&)DB8<&kMiLi;+dB2Tn2+mj~(o4+|iyQ_-D@DyoPjD zml>taWrhfW^n0woS1%qc`OGj^(PzgNhNx!XEKoD?ee#my`PRnoLyTJ#_)FLroef>C zmgW)LIE!H7rA&VV4nnOUmaRML1)JuxLQZ$;Kh6(TP1sE+Z}b?mFfU&{O`83?bUh7T z+OO0H)D$$~qVyu+hXzibjsBP3S&*WY!Rp!W2W%Ua0B^J>i~!9t!k^iuPuh9n>nRKA*V9v8 zZ#&Sk)bTS)pbb6A!QZXN@%*62<@P}4cDEPGioSG8zs4J*BH2Ja!comI+V^yf3yv;) z#B4%0U0(Ossm7uQ?Gin_5uzTZ@tCWbUQ!b^=U_i>vm&?8Q6jZ7NEkC9q_8>Gu{x0C z%7ZB?0e>srwKab+J}}tmgDhGwj+lt^Pe+NMHB9Yp4D9?s$&xp-DR@&0sKG9rj_yNH zkZ?BAuMMXQEjBt#3jij`2pnPe03lYCn2{lY7lEs$^ISqrjlqDMb!n_zJ#+QL=<|iG zEi@+{rpPDso?fS6z@v|V0lD~Ot}G#-=2dUt;tnu{TsWFMk(EV`agJyIA5C8YRb|?R zdkE#wAt9)Ary?LAd1w%%6)B}Vq(eYDBn2EgBn3pIOG1zk>5z~P=`N|e`R~21nOTm@ zrRRLH-@Tvx1i{(SrWA-GcEGjc%(`-7g@RkJ<`f`0rJL79%}>1>|E}Op5+tQ%K^q+c zW;h|BRX5kxCTACmfe!ecB9Fwm@@0b@3D%uYH&k;a-NyFB71RGF#!DTQUV;zi1Cv7t`GfDsbcOnBx=i>l)|9b+5YMlA6WS4;3 zY`3JD-xn_a=-I{j@b_(|+WgxjbTov+Y$3*jM3cLZPCk}A6(ot+-*NI;-ZrCWMKopx zMm@`F)<>lLJ;#vCkeCg;qrykYJFF-!ZSjUSl$`N5*B5naZ8;Mz372HP+vTR1wjqb?6|EldBy-pMOgw zBt^drNJqfuo2^|*=kV2M7JKdF^c~d5lDIf~%G@7*K~zq}dBMQ<7eC{sHWa6rgxJ`^ zUPP3v)zsvCyKzH6aKrBRJ(0VvqSDcM=UF%%jt)ZZHEE>n+K+K?7z;E{V@ys{_9=X{ zCN?}mMcrCA9e(?kXjD%C67oWFmfr)=Sg!wo4Iq!~Dz0g~=5*b}r*iJw94yg&q^j5j z?@2vu*Igw6KJ*0PvDF|jUgnW>gB+y|gZvB(#*&_%|0=;j;Ef8>Q6-5t=z7_#c8J-T z^e~@|2{W&bI8bp<{}#+Vf5|*gkm!49L0^7Wh%l!z-1XMFX%Y60Gla~jwzPvzb@K*I z5RO%P2&2*$&%2#2Ih6)`v3Nx) zxF{TvsqW4oo%>d|f^J&v{OlWnua`KQWQji=ACjt47;Li{q!8Y&rG$0bMPx9SIPT8N z@cTK!j{@E5&kSN>mp@^`D+iM?p*zIHvA}Mezte`y)qIrcHuKNRNJT=Gord!Q&5s3r z?_RB7T#DZWfAYrwHuNw7T%(QlCZ}+Z*0(H}B)KsK=lKgdvI>HvXtZ6t^ano3F;9kX ztOTo3^bU6kbvR}Hf1yX%-(UOd?WmpM=)0%9h5Gffn}$!N zIi{~>)6`ge9!m(R427?}8`6xqFmw6m?g(`aPKVkBp1fRr(Tw*gR{IYNM~{4r zi1zkNuwm^-dgyt9kL?D*z`)LEVyS}8M>VtME}P&-If#N z+p!J(_HFui%$GYW`mCkP-C4R0K{u0*DlMXwlg@KoMFg+$_XCzZHpck^1H*MtQSiI&MYTqUoatS(VbQBlCV9b8M_}_QB@~U`So|1_=4Ph znNWYJyYZoXm>-4bBn$EEb8)!UP&w0qM3rb=b`M$Sx_zIa(T=8u?zbo6_+lXlT3+0G zaTaX!QXYde%-pfXjEh)QOE1VlgfOW)hA~#ZjE0^)_(nn)p<>}BSQ-hKn&ruC{i)Vy zG+Av>TcyNKl{MZl@7-_74yu=UiB5#{7uF1tpAV9EKw?D`Iowag{@3KC9q(&^9`x>R zr+k3)`MM4Cb(IR9V>lZgxL1^xnD-gz zFvz~^WC)CZy0Wyg0-?>@QJXIR4lJ)7h)NrelCvQS;Wk2#o8k{_V6UJ%XoAN}JT5i$ z+ya=s0^0!k-=o9)UysDjB9Sa$3rkG^k+hD(rW@5J7X#|g|S_rpHl=!wh%cWL=n67TC(&2b*D)l56?Ohy@UI1)i@my8h?Y;OB3mb zf@$P;d&HvgsVMOZuk zI5rF2AdJj-G!;_@Z0NK3S8NH2)u^nRrC%d90vfPLzj0rHfdK;ydyc@%zZB?S|0cl& z=bm=aNC**n)C$_`H&ttrZ;1#rzs}{HQdv>%M5e*MB&VMQ)GCFNg8p)Z;i?5{ce0~Dx z!)_}sPkaPCCO#n8%G=mD_{Z~&kCB~w>$P=mYrXy3@lc*7L2PQSm=F5VR`*kH4B~LPbudGVBg40$r0%YJ`e6wgDw=+xj{Q2btqoSQ2pl%?facs?rRot%v1?+aiN`7HS7HuY_P+DPKpW%sOt zZi-4#p>LtQ-)!C|pddrFIMN1wAD_SJE}D()i8a#EmHm;)gFaV>K8u~2qjXEIxa2mD zfnRw2<3D7A=^@=e5$LR%idwgG`4E0T%*tDg%9@SJGBY!06R&u@^c~BdbFy-C=K){n z8SE9Sh3TZ{90Ut~F8L3w2C{~44G#~y!fwF#UryocP0%ApM%#D^L@hFBs<<0F^Nlpiumn9Pry(E++A=b!FZOfe*L>zB zDffCV@8E~Z3Mmm=^n}64PN@BTm74OoMCoC^e{@f*rStePLVj7^fA)8TP8~ZdSk+k| zDC_ey1q&{3%-_AKSx)S`SY$jBjOgsi8KDF@k0aFZnsrrCztGyXrYu=<$IuWj+Z$f=L){qsX<=kDHK_f5Z8200@@U#>cX&B}Ge!5KvWaKF-;_e*_j8?N=M zz#05c42TT=Fq%5~LRK>G&Kc38>lNb$I;L6qI9im1G2g7A5>6&*U^hbWFR4Mn$K$tJ z&MnNIME14*OI4(yad*(?vNV$Vr9Vm-8Q`dpP0kh#$48{4&TF;_uYC;rK{$uwZ~c1J zHpG+Yy&L5N0xUe75&fwR60coo?Tq7%%hkQtAPV}y-?LUYDZ0mn~AX4m?A!0fu& z=g6L|J~*Wm##pRDIy^0`dWz=7r;Ln`arj0{hIPO!vUTewPb5-H#{&b^+~wM)>l8b8 zC!Aa?E0m+Rz0ioGZIC6$w46p(`M%YfH`;ixbo~wTPm*qFH0U?{^=}mZPPs*hb@G~y zu8YJwjThy@%=ZA3R(dl?`Wg47dblT7;*uiK5wG9yYJgyCd(yVx`&=d{0S+If{4%_a7fb_yxgeXc zu<(ixsW?oT@9LQ)!XqMHl_%&`3+C>WZej+#>zU_ld;Gn>v+031|D~Y)FUe2kNDuBi zul3u%gi;r{GrhCo*~y&6v_HW4Y-sQ+9GyrI?Pe#DAd`0jJENdwt;T=Ltp3SUf6@n; z6b=z{*e(&&KCpb66TjH@eIZGN>~Ng*xC~y>_SIldkS^2=Cy!v7v8r6&6?r;r#m~mh z{uSDf74uwm1ub?m_!UidvWgcaoIhXt4OrM{m9fon{d$ocQL4$F1)32tF|jVY5DiZC z&JxsPfe`LyEb99Gw>BbO#ME|A(R_YAmB!a6rLx462wD!riIQsIztyyyZ}jpdtLF{= zz|=QnUEGiLzG9*TEik!+Zw{k08Y$+vb^+!IR$GromJrVNN`3u^RH2v9eAROLC0;NmM6f=}HJchAwD(Txy zRM+A9UxJoBnW@O@X#BdW*~jtJS0bcj?$FA0j5 zQNjO@-PQM*JG>_HxARv03}~K9G)+iI^&6gla`%@K%DvL_zJs1eC>a`-0%z+$L(z^p>%d6$P1!XJ zhphX!I(As@DnT!TUrJj!e-Zpz#4J2-U10!1x>Y zWfq;q#%A>UAj;0NT1D}nf2tOFu+UTf2Fu-~KfFY$n$gbK@pzEyniAf6JGty9Tk=-+ zS2@QK#x+M+?fM4KJ#d^a!q4zN{t<*w>=ERBoLWUwZ~(!az-ec3!C((EZ!{S zHU4i3^{${lzF>g#=93Vqi6>9fe@hGM-KL;!iJUAy?$CHp#v-2a`1s=m3_J?JwKnkH zmGK5zZuNN(ob+$i6+y{D?gRVnNy>bYNac?M&CpanQd~7a1lefv-hRiQ{HT(Ct7!mb;u$oW%-HLNb0}#Zob#T)q{2B$Uo?mPL}VE;H!|YaAgo zQBUkR1y)v29`7+&9njrXNo)ShhJ9+~TBP2h$<-`TkDYL_qPPV8>YpoTQGoN1czEYS zeF||V@It#~2N0ne8XL1zS$P{98c1|2EF3=r3t=51B5q3|%X|PJE}$kF4%A?sbJe~` zB19(;h{pebTR!Vd-YR478KsCM{ff1Mqdv>PN@Utk-)uL9b*dd>i@P$NlKq9OBd%8AOe^|o~R+bq_J&W7&PmyjSs7_G^p zmez>4-6aH>+y!Gd?=LhY(Ei+PEAdQq3Y5wdC1lxuucq`%@_SLsckSFFrd#OlcUAt5 zSh*MSZG`IwCEb684$gq#|Dz+3b3X6)oT`b9&S-MjTAJ}uCUmL&p7kSQ7^{z%i5|(- zC^)c3GD_I`grjihWf7-SU}FIvTB8-zfr-9zPwb_`cUeC1j1AX>o80Bg!H4 z07nj=Ec*AkdyWvU!{Doy(o^gm^`!fa1IEZh9RFAYzi}NT;oMyQU{-$uQqkQZSGQz# z#KIgWAZo&aHh+iPS>aS;PL1U3DO(wtPVUsyRNG^n8ADr#K%(Wp~CcAMY8y&L^RmwA*i z$DfFrT?OGgB<7fk$e;ATXW3CElc&0e9-pe39-B3LGmlGtiT zw0%0EoFDM1iCBfutmFmL-w=d+HOic|(|ao89u)!wEm9#VMj~_Byy<_2@uy!!SgRK(FmwTLLqc@7W_@eUX+Y# zSKp$cio6LXWIZ5gzL)?I;Q#{_TJogl{w{cyZ#{A&Wi)8=c_S??yBwe{*yH9)KE@U? zi;R|kL!^lrgRmeI=6f_E>5`tPbdTUJs?ln8b?w){uSYdG=tMltnf>(gB{y>Yel7&2 zsQ*s&5HxnmPJgQGEO4_G8rl}@`>cl+Te?^bsFci-55(zbF^#&381%KGU;g6~GKARO z%?rW5B7IKq0X-WHj&^rz!L+GS6gU8SU%>X~6)0cs@PbaY4{kWXV+p=2yu2g`RW81G zcS{$C=f&|3TH+mkEAAFI$oS49$#U%k6_8l`rGb)J{%hm}qH^v9LezF$Z;M7bQ!5x3 zY+f<*PDQD|`u^duhN1ylqr>{)RD()nW}tzp1na=b(u~&Y>TN*Ky}IMp?6gjPt13zg z5~wH<&mk1@hsw17YK5Mkd;gCTi-rJB8P586xz|jZ_{Ep|Jbjh6XH^Fd&*tRULNZ=9 za|8y|757LLI$eGl7Om(0+P!6kGfXS%jcM<#v5x#T%vMxu!HoVim33~2g+g9<< z0MwH-Qk#ZDm0uVm7D|F46Zze z7vBlRr}hJ=A(%poJz>|b+RF`YXj2luwKg7ITOCO5U;~c@!b~g#XmS6!&EVq_=5OUl z=jh-l=$QY*dVqaFQ_vN6iRdA9)5;7`cP|#u>#C`!uc`UnQ>@PKzMA{N&f@bU&x3-h z2=ZTETnrD7$M;wCRA;f*0>Y%jI&mIS6K>gb%*4{0q5}OS!hW<-6wSpG_W%5l7;BB4 z-yvXU^`_7`U;DlJFV8DqC@8Mpg*6X}QU72tKqLD^!JeQP7!+j6Z#&`q9h^|a1Bm8X z*L|k*pVA1ZQsT*u+@b|Sh-uWysntkPOQLnlADkBU-Nz;-q)f(2RTRP=XCIYbGB{-3 zuMhtszQ8ybCNAuS?LdsKO6k#F_&npY6psdy>Yp@i_yS!wJ-*>vA4S5>u6( zE|-?tS|~H04KLE0VIXc{HgQUxO|fMzRY}mYTvCUsBV(oWdlEX!p7d$@6cv+NplB1q zN`*FBWDn^kj@b!bi`)qJcSLbDzE?irf_Ddcbs3OdbhmeGI(Uhk$}IcaJW{*q&j29M zR$+mYt}Rg-H^RG0yU6q*t(LSma1L%FzJR*(`_>_hp_vg;HvlEUSym*^%L{N-+{EF-8S(FpvWFs1fJw#z8dxANV*jftkx6~yU<_EnU- zKu~6N$P!)AH1%gw;LjTh$T6x{vmU=iTyrM4So8eq_#}1XL_>c?wA%}jvKyea|8cFt ze!FqhocNy5fJg*h!m_D#jP$fLe3U$$Uu(F+I!NQrlxD;ob|kFKUa!5nI#N!LPwk;G znUZ38$H3ZK)x6;R(Xo6q+@LXo_Sy^X;S;7@PL`}E-q(tqO|kQBUr(X5#XoJB7zZaY zR=f0QpFa$kwl0(+W7mb~Ux+9S|5b=6c2YRFR8F%RTOn}$+rO9487jP0{=j_lLpUKk ziAz9^^u&6-5o7nuark( zxdh#&LLo_|(b`27U1%|P1oc@JyZlkP>^6{HkmdEJnS=S$)kw}^N-Ex53Pg>6CQo|x z^MTaD3O;++#uK9{47AoPRt7BUd|ZC(k*|2vBF}-4E&^9%5p0Lsfs2bkz+!BuFZp8n zW4;QF{$00mYQ@~GVXTKgzn56l?!25|*zSsnYx5?!Y1DS+ps2svzF$5fn{m=7qox9O zA$Rd^2K)r$027!1$6%wjql*f4I@y_fUTH;^atH-6A^fpx$&?kr58y*P4=Tm+ccPGHaiP7#F$(>9ZH_l`3&X# z0x&PFUK$xoL`>WQTd4S5QZT|}kpM?BiN17EjhwEYO%BOSD|G5@qd3!iu#t@=BC%xG zsT<}8HJwYw)TIb!h~$^<8HB`WuMUCIA>Wh2Fi5DwTC+`?#!*DkWQ+qF}%G_ zKfrGq0n~W;kFW-_-`U5%ot?*2NViY0y! zg-hP!3By1}_gf~df3U#sw!jIRZ@)zgyQK$XCAw};zn!0k)y?t*nXSIdIWd1inZy`4 zO;1O6Sw&eTvfXiqlr)g2)tTi;MSd5>-4-IFsGMKer@Py9`g+iE3O|gfSLL)|bBlY< z=dne*?^D;3kodutUnQ;|%gv)pfduBo7Q36k*(v-gGd$e$oKU9oVnsmkJ~4~P;^tpw zS8yjfx9CgfQktmVo@LLiU^i$Gghh_JtVXW;O+e{r5em|hnyjQeQ3xT>bE1&2yopr0 zhTtjI-WbrTrNv&N{rsaZ`LEH0(qox7Xpf>Zb$20}uJ6pz{IM??$1{~Olu`s?6cK7@ zc%{Vsh#-;Z_Rzyx3ToxG#vEg9fzjP=_C7)&;w>#ii_0pm-Z$&{JEu1AYCVcNlFPIY zZ?(;B-shM9Kf99*1Em;b@qh;AJsBA^pM<>O=<&*-Qkl+QN_QZX;J1{b0-VLG!-em8 z|3hWDKfsg+BNxO8*ps<{22Swy9ipDbPz%$Mj{Pt4PvuF?vY|u4OW|Eilsp4^ac?Pv`IH_3q%`8I6vp(<-aDrIaJ3{ego?>@s6n;j?QaNmy_|XNR-pcefM6xUGl}Jt_OU z9gSWJY~wYK3|5 z0O3?msqR?Ghxj-EpE-!LRap)2(7r-*1B(@Qufwg%EHGeZd+YTS3GPJ|sd6#zeG>lT z{NB)KY;EpUt+CQOxi=_O0e-xLoJ&Fh3M3S_*@IN_G4tn>dWn@w8UF3L=v28YBwp3^ zXdoT?e*RRVToKO!p$`DUfuND>nQLxoWT0;~?qK?3o1wL>W*{S)ev2+nKhsW0cdqj_ zx=XwVJX&^RHq!70E(tJyywMC<Mx$>VGDcu=G|DL zH>-6HuH6)q*)AL!RT#x5+if8qK2R9?oaTQ2_NHD|T8`-*f37o&coPyIi%Be9gV;z$ zd9K+gDGu~4f`abTMWrvKJAtm!0uyZhyIfV)z0Zg)v#qJxJXnDmyMkJ~w!*c3_(0h7 z4_2qn83Vt*Z0at9=(3%6es5YeI=BgPKTVYaHYi$wW~Jgg`9}utaPivzOV6S=2sdAm zu%tSsw}0=vE|64cIT`VR(@|Gvsc9kd(RB0ApAnZASb`7%XDqF$+4@|gJ4En-;j-eH zTCk^zOz7LaR)b4U4H7Ehn>TLsc~z>E7^o|PrBydfSf&5(bLx~C-9RBhbn(#-(xZZ= z1Rd0;aHC}_7vIcg({kc+Fn6?tWu{FFQm}cu?98_O+?%fj;The;K+Bww`oX=en?YG{ z$92M-;f}BQH!%)L|M_?553Gw^oc=2Yv8!_@80$Kl-v-Ych7rtW!Bx; zXVUUFUhz=8pr?~;*@rFDA6>;R=n-!7TgCGxqOv+u&~xC}K)AcRtCktHzY5xa?Bvs~ zUAP*rkvv(3LcUvFcM-1P3gBJc&!Na)C735RT*1)L56TYg z^J$2hi_uyiODvhrE$K1*92jG!6>k^jBVpuTQL|PSGS8%RVh^gI+K><|kUaHjtbi{a zF}O#KQ9asq9MoZvO>0`y{OF{c5S)85<^;Bfl13-^^u2o7sm3j#-!i-hr>9%!L_m-E zAvP8m7{buan~3}Fn8Q!m*w||7>L!HYxr7Jsp`^~yDugWFP*)6jG;JZqyEnS|;75FP z=LaS4g1>UpBy{MpOepfsoD-hA0ReqIn}6ybsdp!!kS@paS*nZ5XuM#Ff9>`Zbd|s% zRSh)vxYfOkiL^J&^sXz|c2 zj%4?DX2!hk)`8cP7d*+vy7y@YO|;7ucPnr(%g3KIk4jx1!Zq31nzNC2%7ch*NB#%_ zQ%;TE{hppD?_?Q(H3vE55R}o2Q1lbIF)p(LTjblT+rE}h%(^ERS6G-;gB{xG@11;Vbj0m!>AM{H@_dHy|;un?S5HHrvtzYj6p$ISEbY=|&dY&~5 zuL_M@GRZ6SEJ--N+4q@R8^Qh$P_EasePPj4*9O76rK3f6WYvX<&3P2k5+rk9v8DTb z{_mF{IhVZIi)79aEWsAK? z474;oFX1)r$q>H+(mhYC_QGDage;zYR{PX+SPZ z-kfx+*%~ijul6e{%e|MxQCz^5aN@oz9V!uxk(S$euDHKnKVWo}x>}wS9}EioYdysO z`%0aFeB6cs;@XJv-{;dizoM}&9iL-v?ItE0*zeLBpkwiSwL4kz{@l4m(Kg~z5B;6% ztLw-~448e-f&}|Odw+A8C&o9UQGsFcuTWuinL4~Uiz=~17M`M#SSq3DRRn=k4Yf*0 zM{A%ku787(tqcICKMRYCCO&tGjqL4dG_KV&>fPvwYe%zQYY3Or{^5gp&Aw4r>;O4& z&*egNqv^)&Xs%7h%!$o!U+CLZ1Rp$S?r4haxEVd>b#UTP5U=jFSveLTONt{iO+t$R z{iA-=t?62g{Aer9B64Tvf2H%Il;VXtO(z6v7j=Z8wIqza=NokUt2XFZ`1g1x3D-zE9kkm(B?(VD$=GWHH2-r&>wSWHO+hF`F|Mx>_Gi)&?Q3H8mqa+knZ|hro zQ!}dtZ@H)~%4_5<5dqd`+Oq1bq#jCs2oPCg(qV3jpV0m-;%U0O{GwQMZLTmvM(^cc zT>WBBr!_G?5{B%hAVc2{VF95+h5fM(xAln;W7teU;@NVL;221z4$KG)yB)%%R z5p?Gj8SJvpL>_qF;XuFKiHmBLfcsSS=4`Wi00Aa{4A&Y{h>;Bc4P2>apf)`Dq@Jtz zpFwHgQPyihKD8>FamM#u6$8D!DiL8}r-DL4ryoFvx&#MG`Y@1c``}eva0Rz>3O`_7 zt=K>_+45oZ2u?S1aAJZ|_-VSzHl5-9wpIec6B(1!g2ZGrCP@Qn>^M;mym&H!Wk+e* z=VUKV_KSHmG#>8tL0k$L&9FYaE;dXO*BX1sQ^Ia$d2?pBx;r4J;o_$8zA^ubeO}70 zF-GN6kCw9!&t8>CQ;!Ctehv4`X8&b1v|}X!X9HOjLExu1aCvdOfJ@F@(G*jO@#rXn zlve9O-Tdw!T4e^&2T9Er9Wo<(pLgjVNeN)n#fgfFqFuj7SOj+^kg;FkM8gK4gHjKW zp^s5fQNF}+Yf8iJ_ZlP@q{qaoH^Ep5{AWiT65&Y z^8^xg-8-$JaFP4R`G+z4I4!nxw6xlJAX{bz(bnGH=zw7XqEdwS<;aIuO#0#O?I#8d z0<(E9DD`)L@5|cT%7l(lT7F9j6dF2s)6^%1iv@7_o8Ge*6&7gC9W=f@C%X&2hTptB zd_kC$0B>1rvYAdw>%>IzwOL}K`dT2-3X5`b#SU~UhH%wZ7p_Is1;CiCm3WJu1c6i5 zuXvMuj*gFK1i^8w9cZ3ZCj)Xcm5rd?xAg;g+2fU~Z+|Uc04{dpC75>`S6!6l=5Ymp zfsWSkE=f4i+mbK&`Fwd*6^CL~r7LY=GgUV=pK(G>KZcqP@+PM`QQMg^X(?7EKiCZ8G`a(o+3e*9?$B&!7 zU=)I4>JoC6*74YqFth{m7I7z?jRsLHG*g!(&LQDA%J7?CuI8_ zK=FTLh=mnWTUJ)K;(K-BmJb@eTCj*3=Y@4+JLLXh0Gu;5IyqS{a4w{54NX2z{3hUB zJzyMiYCB?Ix;@k6r78RA&e6L>b$E~h>D&CHAYbzwe;_uByU0hEZ+5h#zzDJhm!VE| z%i{#m+hfPruw=qs6LEKMFL~o~t!O46*d<5FblNXb@5uA1kAFgwOdDZr8aRo8xGS6BGvSHgu7Z`H`mqK{M#@JU7(nny(%*}ho zj0*Ialc@x6Th-KlO=_f6Cd^1ZS%Ru@)JL2lbcjg zt#LznYhnfh*ssOOiqiT1!&;p;dOs0$TgXO40!F2TuDfOiRIKm z<@UV=b&UpQZc@oJ6-7pif5jDPBD0XcD$3VLATfP#M4Z2J&isx->Iv72>KAqPSC=iQ z(0IsG*ay#s#{K}-Gbep;Kjg<^>8Q;65A$4<5GQM_kTrCk_*Umv*(f%K_qf(o5pg&4 zS=H)>2ce|Piu5kSw2qjCM$8=E=ybT~7j^KTeM8@iL%GjB(;((eU4g1Aha_%-UtfUs z?A~1}s)=0qpEtn67kWfT*Rl>R7{Tc1sFM^5B?9E{vfm>kE-wL}nTA?zZ0iSY!14wp zyjptno{v{rfZ4)!rAN6OrEV~ewSk5U4NoOzmrDCr;v;WXjaw<}gw#`)Tksc8qJy?y z;(v8Y6zbIDrEwX6Hf&P{kB5BT$=`b;J2bvCumJj0<~ zcEe(sZfa^RiN1x6#n0-As2Ol|Ql*pbz7AGz^0_bwe|rF)Rq%vGrhId)dG2Fg8uL9r z3?CUQtc9EHUT_)n*R~j2%=rcLNl1TN0cAzf%|EjF?cfccI3U2^zs~1iKrW-MuC5n?LiZt7Fficb z$Au|Ko9ly(8yC0Mr{QMc-Cq2HrgY?{k~DKl!{FStX$NE(|F$2W7h-+*(Z6Elj^(gjMG_cQP*%ceJVC!JciFUh2^1tvh&sQB$8P^7Am zp%_p9{o4aISQ8%xo7Zj^3>JDtvuky|!ffw3nzkuOG)bj*$2@W@O&FOM>g_@t9D988 zUyrckg1kAv;u^YSnV1PBX1F}?0+=(y;>-(#4#m-V2wExcS zxDjGHHQ_$6up z>N)bgmnak}9e470eJt8|x`X|m_?D>bdzZ3Yr_VRA5>8Y}q)mjddRv3Ha+p4_mRXM_ z^5n$#)-r_Pz=^j4CmuY6zku9}Rsj9lmz7a2(SL7t+Zj8aY&Pcx-PyjEc3D)@;8FUd zfh=J92Tt0^mAy2ho7c-U$>`p0iSEsM-j|bfDm^dQ?23O!+1hju{43?ZTyD+^Fl^lK zeM|uo({|XuUk(!FZA3|C_#TZ{TJc*K^AwD~w%j*()!QR&kxW8|lM`6{uP4ne1sSeGbV#{g9MlSp0*tmK(gcP{sL*<_X&0<=ULB+Zna|(rATS?j z1CkeJXC3a-)3;_p)UngGE4+w^2sxNcn{~5*9l!`|#s1{R-$3h5QGwYb?hfp*8`=%FG!0RZR^K~QwL+$J29K^}VN&M>A@z7_5u&@k9^PFdGm8_;I z-`FFxi&$}L5>e*;#sbMP%uXtb!{yFVeyNFd$toe^Cd^`jda{Of+;(Y43`g(8qgrPT zzj}|0-^8bG$bx=G3<2wiWpMKFUB!wAbtaGvOrYGDF83v!4b{&2xgLJoV*1Hn%EGHL zs41MdXVX8aZ$Ra4PGCbT)#c@=*{`S?#gg-l75(pT$n})wLE4 zU{w+}Q!zSe^yj0yx8a1jb?*w!N=?fa|5`Ljw9kv?`J@(BzX;pEvvBx3bIX@Y@u(e= zaiDVhb=2ne+euC+ z(5!H?GpZ_Q>YLIDo8fBtYg`ty&qQbu)kNjn8@0mxR<^eVJQpRljXPu^x2$U=#r_+b z>O4cl#&9`|)_R+ux_t0zGH=6(-if^e8%~fUq?!!CU-#-K7t7~FrrsARr2@uH@J4sY=bzSQ8c*1e6XhR zC|&?sE;9n0^Hc5-5gApPqi1d*S*f|i0f6D;jq`L6z2EQB86zo$=5ulQ%#;>j{Ze;s zdfHkYSS_eTC?g07qur`(|4jH?ZHeacDUYc>V{8ieT=S57M9-1iP<@$0P4hQ-ceE{9 zelZ`-!$BL%C2L1l)2$RCzb|^PgF1C;^%NB*{z$7EEi5&5PR?&dI&A6T(+i!D6IhZM zd;VbiFyBtl^rH0h%DKn>XB@hD7>G_##W!}EXt}uw%+1ZSvp?>+tp8qGce?a3)_Yt@ z;v&BNjxRagV^J~oQCmpf(EU8~uWrLOc&{8a9ZL?jdjHf{HOa3C0Sd$XG(C0y3^=rR zfP_;q3TALc6XWBR;EL>00ug~Oa9M>YC@3;usyMYucAWwgg(o%^4)Pty2D!4lg2Iya z0M3e6un>Q|ytO4}eR+N=B$NRs`A4X=zFywx>FEhK2`O(AQL1O0+h}s6b6iRWKK~(m z^I6V7RkcG&oby~mUjjKQRM7MuTv?(&JHLsEF7{n_#^;UUOva<+4TQPP9;*s^^ZK5c z7AfKMog<%iBKP`NCqc7u54a&s;$Dd(r%vE`Zn%*KYg5IqZN}ma+p@3aGWO;Hz1@Dy zfil7JVM0UlvWiqmY=tI_`JKaojImU=$`G-JKBEVF8;0<&rLbK6ZvE8 zvD@m`&(M^Mu{_N%f+%EPg%;IwO1Re7%Ju&G` zSbeuV&tw__UB3?Hj()X<8Rj&J%hVd@>Qv);8N|js0Lc_M;T)n;&Fyw~p?w^JX6RNk zwjY!w{#0>apI?yAr&(E6W=Tm&IX*NoF(J&#`d1GGU~ixgTrlUOir$<7A{G(7K=ld4 zzvsXs5BO}ZqmfbeDU5`X8X6i!*Uo*p(9}1)Ksx5bP3TGHkAM^La;b)#$KVNcae^*u z!y74dua>=S`We-cOroUGkmgIze~3X(|BY)Oc6C1J=QWl?%-}^<@b053YkDuw2^Q1- z6*Zbi3>E{u4#nOhiiEJZ*>2yBu<4h!|q({19W1YY|XBog1`TLtTc4l-yW=7Pk_2<(A(>F zF&9E}TgcP{{cy$;|7DG}5>{36x7=B>*QvoAaKkK|T-cnO7=7TxjHMl=a!g!7C@^4Z(HVz4C#Oai*UL`wd~T3)S=e^Iu{9sXr{n(iF99u6A~7hgEd0 zE41_@5m(H`S_<0Q@h`71U^e&I$$nu4mKh1ly-C(u)hcPn7u^4-?1M3#9??y&jZAFe zzmJQ1Vpg8}QonTU3VhBWHv?90-Ya2L@&z}BEwS5EcOHV}wUys>Cz=^U=y5f=m@cj@- z1%lKm~t54x0s(u3j;~sy(g7KK}xYfC$B?oX%^ih4S_uT0c_};CfLM z&Nul!;nwD6ndL2Tn)hYX^;{;Wfe|hn z&U+!t7jQg9LU3t46}X5MtHU^K1}VcOxTLH*yVu7tWUiM45d~vW35B+`Nw02h{%N%l zs2?fT(WnPWDjl74aZ1V^K*qD-Ldmn?g3F`1pDbk>zJ1&uU+FNycJWv*eIkzO*8j@B z_0+i()uBIzPL-APX@poQwL3hmG^feY(S!h7SR_{+t8I6E<2a$MZ4a5B0o4BX&%S|= z7?G5eN~=zluK%A4urO9qIdvTZveNpq(`MK>>Y%%Q`q-bsTKZh?{}YIHDNjx#I~O-^hw7c`%RE3+A2L-#=L? zE;E`XOY+|4pL4T(2L6Iy=HdLV%PqdHOgA@WMA%?n^7Zcf-WD?NDVTR71egsqs z3=;|Iq}7{v#B~1}lplSn7eia#=cq;+TTvw&1Cg@86JQE zzfcKKhEO7Zn0z=GE-<)WR3KhLPmL%B_w|Hvo6G#rN<@v*N)#SG{$@SQ#Y_N?ZPMm? zFa0~T-ll4^PELQVPJ8{D<<}I_5?efG=E}VGzSaBB{V~+@IW1Gl|9jnP&0sJ97l-i5qOmEvv8;>ZrHFWB zZPlw%q|j?^xW`Dkcx2bYyp#o%d`*o{{u9B?rf@}y%Zm>wx>Z{Pf>1Ajo;Ey)0OvfP5iZbc0Yr2SzGJ&5U-|ru?VLaUt_x8 zy^y6y<+Gp^>ye*nb*`tEphv60O00AyeX0VxZhQ)g5Bq)wrDIBID(04KpNDqc`dozX z!Qzc=uYP6ONZ1PJt)w!0dsE7aPWxX^cEwjd?GKh+r8!<2LBMXjBPmW032pdF3SdMG zficZAX~M3~Vs5?WS;z0lT$Sa#>GiENN%EYTPz%dUJ(Ozl5MN4158gkpIN#a>@|4@;GfrSztYPI>@K#_;yLfJ5!! zv-h_ORYlmw7i6D4i2ZLCf+ULePES%x*SEG@Wp(601c8?A{@LT=aEub>Lm+bBq6UBP z3$x#2{8ih(#Wp$*ahARdxO70R@T;+&}`!;@2;XiGhH&`#~(#X4;CSr;M z2&eY^0^8|z93AM$-{$}M26ZBUm)E&9JyEDt>KAK!lgvltO)6u)64tLTTN-5jNNC|M zVK>Ragz0ykWeL@mAu#mHars>mq}3X(rlQN`@sK_68O!aRP#g(de6TzB&^PUiV%I^5 ze*Mw2Nw+OQoc?NiLqJuF-W|rjqvBsHtopf?PDVj7Cdp&9>P*@ zOkPwX8|m%8hFI7Bk=Jj~e3=?CQM<1!bRICc;G;t2*_M#l#rpMmADBo6pVbW)vp)I6 z%-9!7DD^te{?|n1zisFdS+7}bI(5#4yraGnaEu^vah<$!Uo7D@);96WS007TC&h^R z^Wprg@Y0etSq$n{@1{oq@#(sA2B~uBy!a9j5_-t#1{MIp8UV;6p_grt1berU`A|R` zsVsv^f3%ym>Rj8_;rU9wcc(tFw&e6j!_OM$ zlaz?=akrWjOQPn}T0uEyQM>`Hp>#|#G&K=#RPK;-wV&g5)A4jt(T5B3Q=V~kIw9exXA{*iRX6r=jb8}+g$JLDhZE9adg@wl zO(Wlnaa4y-%JphA8YMW{H=gzOgIaYtG#WPM>;V@YnxFM3*>auAjJPd5_s^;pi+w&X zN6e4Yz9whlq#b&%6amF29>J=f6UrL}pM&#%pCc>=NZvGlT(BZJJNVfblECx);Cv}z zlK1J=S4qY|S;c^o$hDZmD>gAc{KiPKSh34N>j@I#?M-WTjf%FxR}8_&UF0;dW`tKu zXdXI8+w70_>&^|IzAckoJ#-d~s2Cn>>zHBV%q=eEgd0vxaec$xVA=?RmEHhwBq3(< z>#vp;I+M!{p#VFYZ@*XM7j4zHhg1f0Wo77onf1tOjBe_?xE<@@5+c$P(46vOo8PeH z^u_(k{?a8;DI2+R{P&ObhS%l<6WYny8EmYzOek4 z8!J6YAJ-)QZ=GvU29Fx}eSHQGF0xn1`ySjGEq<7GC^UBV_gLvb>v3fw*|Y_%OoMVSnajhrgV@n&r*Xe<^t@^`qCb1A!F}@Vimx)_DHS*^r1t#Q@XoDL_h>Yq)WPyK6HmjOA06mNEmdd zv>+1F4bqJu+`;#|{_)>o@7XhJRy?5%rp9&4FR({HO+I|o@9Xs1^E*7z<-_Yw#iO(JI)dF^;xOubyJr5%ndgRK<9%V5k$hK= za=MnlqyMg#f(rmdaod)Uz^C2w6c7|#{Dny*E#Wp=X1~}^om$9a^4>R6xJGNOM(hi{ zdX(h512{4`4C@+E@&hFZqVMZ+MzCZ;5<4P^5hM7NQ}|jHgVdf?^t#% zAh8Zkr6Jst?IRKOB)+dQOLpIy&V>G=L}coooS)*ykWo4@nx@*$FKnat^5q?0Zg}+eayteNa(i>jw$<_i8;f`6TE#0?`*!Yr_q zh9yFU2!`%<4k9mSgp$BgKF^fRZlx(E`4yum%6YPEOe@W&cafWPb?yWo6@%L;KYR&4 zTnPRSW8XTj{eEIPs$j&nGYbung_vY8`yM%uRxxrGA-W(H0* zxJ@6`jyd-PdbkhGtJBYKl>As1dip``q1o?je2bX@PQ@BVnk?hQ`59Sx1HpEc;l4!_ zRwZB4qVM1O*A0Y3YM&DU6-?{L_v>jiO%N|WnO>Z`>@j86 zo4Lk(^0s<{KJSOST-iQyWp+(AT8xsNd43>qG5u>gCH$OHVdu%k8gJY#c8)aSlZ=cR zx2hh&gVBeZmqI&p7?G7v75hRroYKxks%yg6o4J-d{ZMf3p>7oJJKG?i?L-J-Y#!sC z>|zxL{XG`z4sTx;BK4E}@Ub(?C`28iaM^-!{n-u7N*yGmR0&v2U&udvre!ajjn$fW z|IA~Gjty0QCQr&w@5}NNHsZwa?U3TWao|*!3QABUUH~i28_@sDdcHY+HNa6kP*IH; z6W>^K;qB_N?uLAxlSHA$ZZQ4pt-z*x_EEarON5maeshJ;x9{F{O)n}X1w9E~-D?he zviUqOSt%xgM#}XXBwp=J@Jiwb}L^|Jhbu2>tv)klU&t& zTUBH+z3!W5k*0+yiFq{=oI{lI(Uw5&7Cl&q5>54?nlSL^?J2R&moLylRy@=h1?I#M zXhdVQfno!HXQpxE6JCzQDNj-D^Hf(B-o3Go_~p?b-4{MPug;z3lx-Zt=V$ttpIS;8 z6U!yfY3kb|hgJy5SFQ|CnEC|PvtqFRl|OK9RJ!RadiJD0)#Pj|Juk@TFnJ;I&JoD! z&e{q^3)BQcRYzql;h&|OBJke(+Q9?{cP`V9xcK?`8zsxy8Y_SX1)uqtuD^TT-3^Yq}2zD z)poKMY8TcJm&t8XNzC+^6z48MVq7ornzuf#e?*E3kIWNsMuf83O2QvJ*e)5VUkhM9?eQD9W zc)&-*`LO3B0i%i&iG0SLB5Eh-Gj7g&DWg>N$&QMOD)+e8Ytv|fR4QUN=Dk=?)uVx) zcTV4a0V8-DihkObf{M{hb6?uc*#;}J@Mg4`v@SKWd6K(QLN8c&5AKDfX;k}z-{CAw zPa*#S*_6!M$d)d@eXr(|f+r8_d{8yfL#=UhpA}q^jg}HoT`zsRkH~^77`U=v+`l_* z3YQkm>fkq%e^t2%qSW^g1pbe%ztl-z1yCk=;eWkOn|QbrJh^+Mu(F*$Ez{+NoJ_Rz zhvdQg>e+kNMNd(6oZ_|VXg^;-Ge06$AGoY+zn-^o0c-I!@CBgo^S-HWb{hTi+p|*vU#P)nF@;UHkOAN-tQHN!Lb z<1!wy6ivHr1sVfM;x6U!7qA>94@;(Emn*lbxQ3Sx75|_mQ4%um=nSoQpqDXv6%RPk z^1e)30D*jyIjj$0Ifwy+%nI1|X=L&%;bxPC9USl`(YeSTIP`u*&o;tsZNd*-2<7?H zR>X{7NzeOB4%3D=T;AnqW%v4z5L_r+$!GIP}MP@L)z5m&i*icfcopVlXT=9P(0pzVqR(N^QNgeQN;3K|$v^{!^Ua*)wS56zvwV2=ALK(!$G~f&3)H(secNn z^$;@8o67Djt$?7h-h3o6QHTM?*QNma*>pbdheIi-ikm_fH#IfI)jPUusJ<#d z!hp^=NQ=RJPp;Lq%2_5GGq5gy^abh2jVm_F7(W+H#e7mKza{RRxPl>9`LNyhH|Vns z5C-z%(1+1-7KigMq8DPEJTr3Xnn_f+Wg>GXOuWm;R1HW&Cc%?s?H>oyb_F?0cCZ?Z zmO|nzVR%<%pB(wyTe_<*9Uq*3#IJ4dn8SA+{4}BN{s*LFZ7s;7A5!*AK$;s5P6Jl61#3|g_u$H!qGh(U%E9c9iV_{K#DElvykVgWR zX%KYBb-lx8f+6KFvQ0YIQ^G2j_Kqx(PI+pbkV1JK4YG>YnkL*{6MBWRm&wFz`pL*^ z>V4N%53qX8!$+SzGZW4PaYgmhn%NfoWQR<0aQZ!5EJR^bP%tOq#E*RzH-6DcHLU3# z)%|6su-C+t(E@rM8A()o4pyT2AI#T|%B>+${Kt3vND7O`5ac%96M*R}7*nYIV zlv8^&Lgy{H_*6v>)nyW&8bPL!1m1kKqA5!D7E-insDpnu|x9#v`ky&jaNeM)RX21UWGnF#jZAxa&nJS4J*> zP3uOJ@Io1>PTO^e={%WOOv?R&Po$U~z86Xxc*CyEYlAF!6o$0YK5#FY78aVJ0jG5) zpuc}V@xDR20Rx57fSlaDC|HQZH!;eD68i&BT6h9J8J~5bl93geM@%_uOZv$kDoS@+Nxp#Qj8rk04*`g635K?1L6HUCPy5tOfCRQXzS4_?^s~-48St&mp7s}b>4o@vt#Upgjx-N<<GW7 zf$Weh{f*z*u2n}Erq~9~X!%nCA-M5NrrUuV2L9h2u8U*_$M^kzp!hll<3{5*@e%n~ z$`9!m7z<6g9q#|e)$khqEZoObM~)c9v>d99{v5n4(wP)LvwHC}Eu~acl@k+pA##~< z>0=WQf0p;B*=c;t$R6kU+K3d>xbTzZ(M2gX;h)J3mg*=A?xt@t*L2@3X)YEf>Z{ke z!mYU@XffJE7TUTlgGkvaDBz3u1`6@wrbb7$e&WQ4NAEf~v#f%?*X#To%!E55Kff+4 zWSa@aVn=bx4vm-CtNfT7j~DA$p4)B!uV+#{izfo-2IMjYeciyhg8~3C04o7s`odHd zz)5L8O~J zu2_Dnt>N@H+M_JNt!y|09v8a}goK0y8hBzV{%pp0f)6__`~Q3TQGMe|GQWr`~1-&Sp8Tt@zwu zONUQgmV)N}eO(#3!F*Cg7KW4zoni5si50_GtoF|c?s*7EveWZzrrK3b^)P1!IP5Cf z78`z9!6I|T1pJ^rT)?6=z4o8}cb60!&tFSQCn%9A= z0*^ZS4_z^(&=*ER^He%S0%#4wv^q+^xOhQ=ztR7m0pnY)Qke#$;aY-{Gs-wxTto4} zH_<6D?Hf-VDf@%tn?wEy_r#Zf+gE9*7i%aC3qd^Uc^_k$f(|Ez5tCCE|R z9*XgmKQ0(;k+}96I}+(c(QI1W|Md%tj-EX5n$-9?ZfMW5cP|^7ZhdulxfWoBKz@#Z z*MnNPy<%q`h^qe+kA_FnT6<(&^M|W_2t853X1S=Wtv- zmFsDD{-pj%t4B9^;Aup)&RYKyBdX^dtV~Qvgs)}Y-1ybLv6Bl3@Yx8>O$y@L+uH+% z-Zy9G$iml!){5Q|Y+RdeSWLuan;#}#7H1V$eqV0M(rgq1j^g*gj5bz2Y85-(Kllpm z3~(|EfjP8TZ#K6yF%J)5nK9GTBdJj$``zes6IrH>{}v;f4zjU;YG!j zg}<^cTTlZSn_*#c5foUY;fC=A4`fPA@P2B9%Oo(InBJey2=J0eO|)Z?;XT|q<*RwN zn>&m8jj^qnJLOZzFT(jt7;pRVt;K%JihaYa45C$fV{eE4RbR5&&Xk|hvoik|v14h3 zc0`5D#7`QPUl0_A&ODbfjL~yUoe5Kn(wO#}o%I~vIPZN}{=x2^`rg&F3T+>C{ds`& z`TTK1-j@mgxyboF30VJ`81LSt?f-S=DE>FZseBd zcpmn+I4>uuqysMqR8<8l8=lNz+b&>`i~NvWwV&I*3Ps0QT*SlKMB^P&m@g-9i#t(t<+Up&oLesAly1`O@#-*fKIQpk0sM-rg=2SN#&|llDV@KayMTo<}0l4D2vq zphi5G%Ju8SpobQ>wxWN#PSPKm^NRlceS?1=WyccHzMjasNQFp28O%fad`;kDj!0d< z8F=K6q%jF7b0|b)kW}R?E}iB?F!~Ubi>Ww_B>fzHv%R3CT_fPV#n$cVEAi$FhDuh% z+^ui8*bZ?Q)Y^l>bM+?jd4&{8*eRM8!wBC8|^f0SE)eO0{h_wt*B z1>y^}sf}k4RPs{x9ii!f`C{>~tc6J1&-Fd4Y?Rs&Xg?BVd>$iW1Tx-4nPoGn?;pBX zVnW*&hpsn>lJHz0Qk-Bt`b-!~@eF?Q>~Qpjlm^sgZh9-e*k>i%4TV!8kVi{y=biR% zC8OL_N97CdAkJz$vhpxAxIA!2iUf!ObD(J<4S=(GUZ4@D{FV**)v(W$LV^?MeehfA@#Pm3#Cep#}`5{9?16hVN z`oUKeC*`@nVkr5GZQfXNfiAv# zbSz-)xNQy&4-3fX?zVTe12)e1US3){8|5$O_( zJ5b50tQtX5vgN#K)pe|&3nKPuQm>_19|@$Mk-i#Wa6rIJXNT`n-c+lAYr1E2ye5qA z17>8xnTUlOd{Oh3TNx>B8|cKU?cZw`ttuT6G*(j?<*A;YR6ci)~FrCQZBqW{-MaMGPwvvU7IYdX^LeBF>?c{U}D7Rj4 z&F->}GoJe@m)|b)o*NVBq(E+C!R057v1kJ{b&g6?B?gyU+8YZb=YIPK?2Wzt#`yDl z+LK>=<9?UiGW4+xpy*k1B&GR^*!JBNd37*u-<0$gAbjMn#ybi^!yKjze%)E;y??7u zN5ASin&nfZj)jARx?v;?uyr>;x+%vCpg&u)Jv3FHzzGT6)RvP(#|}KKk*=GGEPXD& z)qS|OoKBVwgAQ_!?Ym!v<+b0+zFDA zx$~WAfjuDGHT2nVm$CBEQm8J;)2B~O^m$YF?y~?jg)lvlj9v(>O3BGY}aRbFLD{uZ+;- zTpS!7C}v?}7^ON#$Jl}J;@?tYOcW@&qsE(E$#ag6mC6rV(%j^&G|5oOwODvAZP<>pQ#{asY_9RUw^-JhmWf_=2L!j z=eyTkgqVstOUA80sgYY41DB^E!)<4Hq60(}_HXl7XQcrzN%Q^qi(j?Qtu^4cI}N`& zh_wRBwh3V6j81`yMB)QwDF?7d+iW8@RTQ+Pf%&*06~WQF+KaQAmqYQTtBU{q>L~&q z%M0!z(qyLQ5?~p2moYbjnLi68dgm9A2WH3t7<9XUO`yxB!wmEiZ}N25{YHvp${=Ip zfJwz%RLo1bfn;0wXAm`M|NG4Vj#nIxz+MVM035ilogn2%Qc_ab(E$gs*AgU- zs*0444d;@OuR~WLIx(@#7=?d3_ZcADwu#vQ_lTi*Wk!%nJQC=M(Jwau>-EGKm=YsF zz?MXcMQtmYAiezsIcX^qVZUjcSl?Q=SU~}gG3p(7jsxf4YXP3(M<0MYF;p((TgmaB zuSbKHmX>tM&G~>O#X)pvC@#(v3T1@SO+{m82Masx2@e zQ*h@F85tS*auCO?0Q1W;9`Isnz!g3e2pcYCrKgX0qFmh!^BV}lVy_>QII46xzN-@F zsef|b(nmfp{nhavN#ws^@f8UL9pRo37Z>*~gznDiv{j%-9e^8^y6H(Rz;p>h046sL zkx#j0+Y`ft^y}ZS4l@LjO@WrxhR5#AF(Cxpc#_orEmI$0E$Ffe2z)BlD~rd+#%_c` zfZ)RB@KNc?R3>W+s}0aoc%W0^^}K>n|E~r%eY=>qcG-j!aOnc;xXs#=Q3uS2IPj`Pu}QfgsOitPeJ@ik6NT$h z?nG4yS(xN~_h+xPkf{^oEuJI;tliWD2m}IM4*Y-L4n#qFU7)BUEhBTg3P4AXP-GKn zq)K?Z?!?>epP1&imd90~qpT3i^erUPA~2(kteR;7+SsY}Y{vdqDSsFoi>_-q0QiSN z2vFDjgchFyM0*$DO3oMc!ylXhT2G;7jyNBH)?Bu?ovSH#@!@HL^|G)qUF4NZe5~=Y z!BD5txR0jCU>?xvN=5(uU=8r%!O3=~OatlySb0*N6<=DHU_T|Gg*}`Z*O%*hy@9 zG>ii$+E%1HXjdt3*D~-^^dkdmOP-GtdFrDix6$Ymi{HkRyF@>oz8(JcIdJJiVxr9w zApe#8@7V%C*nj}g=j#uE?ac-KRdpOp%z`ETFsN@}0H_e|&j%E1pMEJ_}nKb;m zdNqVQg_3HRF6p+qnFCb;#`}NIN+U7ZWqH)X4^TKxI3-4`n)~{sq9Ff{T~; zKp(1mdB{MLWgyAQ$_ljsdYtgpAM{zaPPhASGr*5C&i%Tgul=KabX0!&3^V}F9)t6A zo0hFEn;QX0m?U@foP8T1yB`qbGJLPAr^ojiNOYNNXyAM{o+Cu6Jq3NX*eXKI}j0sd=pE!&$Eb!lh0J2vPUP{#v;9g5wosO$Awan;KJHe6}+ zx@vozf1IqU9Tg7|0=o>25vFH|{au|YHbwfr>GbC)PvP6)B~Z)S&NT>;MBg1xNxwS* zWA?}IAV}PM4`;Z37eEev0pV7|LT+})?CcB!Mm~BulFgOhj6|rtAtA`68qd(x2;0Tz zV8}qxSNLPJC4XkQpooab^yGLW8(W=Mi%x|&FeTg122AO0{vJXkI!?~AFM4I3rw0cY z8in6S4>;xbwE4*F0HpcNqa1OurJZSJBuX4pWFvO}BpKdHf3!{4~Gu8)56g z3>1jXA1=>^xbrcLzehkyiVkJ)TVaWA=+Oq8Xy?&-?Uzzhk^fNCH(XDD^QP>xyXTo+ zqjD zUQJS-ToD-w(UPB~xy^oS)PP)JB?s35u)de8AiKuj^`!4g4mh3AH;p3!36JSvU_6Qwpt8k`PmpSgNCu zTR`NZ>2#Tj{AeETE&%tXV?-M?0jmchh!>c74gu{0-s@gk{i{;Guy0EyG}5B7 z^j*saiWGrX!U?R!qr(A#zh~>mC4vu67WPl-w z9D1e(dc7fEKYo&|1fd1c9!d;@xsOtkLoSzeKp>+twH+G>edUkt{hWyV}TR} zuGX9}WfU6;=XIR{vUx{&t>oO!a5^IeXKwDeB(00Cq{c4w;00&Y$CMNUU8>hk4}kDOaxu%)d}L`Cq>|Wz zos+%uKsk}-AsPe7Eh$5kXa)ei>^rbFb{U@jgL^LvMi@qwn85% zr^n5duQiqfI?HkuH(%I2@^{pGwRYu8h&@=QXi}_D&TbG83)km`G#Gl& z+HU!z$WEWO40IW~L8;3J$XBm-XS}Ypw5}5fxf*QPNK60ReO~lQGrmvN1A}|hD--7^ z$k)kt&Pm_~(|&cA6Zee^fCmFIUbMXlwBFQbXTR)QZuhPzIApvR*7xz2zW92D_0Oke zdic5w=anuVR?#8jfn8~-F4pu+$ef!Mf64gyvnLV(XXhfU@p)AqHz8=aEq}H-@8pC% z7NeCiMVx6MQ*a^18V8(yQKZ(BO=QG@D#>G%KG~SP zcmaRpzo6yg3$DoEaBQ;W%|na(d6f%QZVSPG6$DQK(QBBzUFyw*4MdlzaeL`f*87N_ zZ6BA<*=ciglnADs~L)Cgc9WOlT1C=zCz`tXo{B=;bB5Q8Go|Y>E69VclMGXHPV4JP6Vql6b z9eA@wmd+#W|J80`1OvTf`%nJg&%DMJUJqF^H5QXk{81Az++h}r*$RT>X1m*6S$IL= zSFMCGb-%vlcm*Br_RrWAA=%oBXEu6|DGRJ#HCiXiEKT=3tAymRd~?N4E^^SG?(y#?A* z9|ADW@JD}CM1OrezwTu`k*Q|$ay`;WN)v{p)nZvGWPhUkh~~hK&8eu^L;PT+C6RHm z!v13Gecm$Yz7(U&aVd9?{QzM%PtbnG?PLERSPWnI;ZgYK7dpNZ(X=G{^U6$aIlS>= z_3zeOPnK`rfxBv%7aGhKd)@zER*(S1hpvZP$j9Gl2E14ZMnPGXqp_9nWUD>qjZE}= zw3ufTm-*uN%{M9WA zaSt}pjgF*R^mFl`o9kJ^dlWMdect@?(X(L*n82hxFG@Osn}>}3j0ta=j&1ykFZW|w zfCoSDxI*NgwRfG*F^dqMIRT*TBLLF6t+)66NrebT4 zgSF@T@m|d)B0k2qXr}XVuiy{(ton&TmV^SNZT@o8<)8hIzbEk)QZQ?yIDQZz-{(#x z-D1gd8F_G`NBd&D;eo+iLwoeyML1-D`7iE}P*7kFi+v6H@?{)Ydr1!ug=m-gVe~Lp zZ$~CdP;@nkr&;nB`2Lk89c^TEN?)D4Ic*#1ba!)~d;cge;o{<@9aoq6UEBiQx{f>J z$zN^3&O;6}y1~deX6V`VpZH0AS~?<0-(+YDV;j$p9j*_Fw|;V2YFY(!W3YrF|N9)d zG4bahbbhB3;qk6+H;#X2R_P{3AIYRnN+7+5O;3oiL50NgWod7hl3q;6v(4}E0`5vS zCtz@vw!>rHE)LB8ImGJ&tjlUBh63y~MABqQfya+FS9IjFX zn*G$1Z20_Djbeue*@6HBqho9RVPlx%bPYQmbaZ^Yw7IF;{on1B2x>FYjhe0Tcc&U7 zLo_c)Hp3BQzj$BI+a7))z*Po$?ts6zh)Ty!-zB(k)UUJvVes&699?-um6W{|CDx zvNkv!CbE(h79+!JhV@Ra3ePB(M~(OV{vCopz^|uWEWOvL`RAe0$r|3on~7kRPridi0tOxzbs}M^ zECgOO6PeB%q->Tw4J!E5dp%<5psP3V0}-VZkpu+7V&FA{BO+D$bH4A22;(fe4f^*l zf9AxT(uU(7Yl)&0)JxJ9X0VwAzZ-gv=i`Tl4`|EZtRT>52nXX@lDNAX^;!h9omM<{ z`d*Quu~2Vc^P~tAT)zo2zmeUbN@i<+|D4EacRzTnV>y?$(r7xDLxC%`u~A}dY^;r( zbGjv<7a!@y^ACtZOdtxC!&mB1QNojM1^ppqqm9d#p<=pMn9fbpryDb0vYLQ?SIZlc zrOxT;Of2Ppf#}X{3I+P=Fu(Ks!({Uod=s}e$rR*AKdxNyd&uk9I(}AAx;yKUG4uYM zJ6e0^3*Fg6KMsyk`k-Bi4$%n;5`$VeVf)8c_f5c`ufHm4=7x_(^WL~LN`_@TivRXH zfyTQt5--w+0G*Gl_V^DT^_ymyiwXipu!zSgF~-lZfKxDt&N6qT?3tzWf_kNfd!7s!wOzU(G5(Q=JalJMAsL#9CUN!uBp zf@Z$lr+GSee&Z>PaWIXFt#RMuD4KOSXB?_UW&`|Yb7E|)`)qi-voE?tO!kd`mOk!% z2J*!sANzmLFb&xJ4vE0u`hHbyi1Yh(!Sj_zyghUj4@*c_2dF{59rlYlS#JL}wWY+Z1@C^4guR}q#{uQpw4Cp*JXb0cdrNCn^q zzdVGw9DYmzU3drUxYQvKHG!YV`{aKa#qG~`58psgW9!wtaAQfnS-kR>0%NTcyjEK&;HWo@@!kyF0b5k8%_oDU(lZV4kSF{fEE@K1Q_hkYaFIy)&g6CpJO!5 z3qBn!w-Vdz#uddaxVFp;>1$1-A!(+8v|_j=@dGm6^zt>G>TM=^eck&D^s<|B_#%MV z4Ds>C$osedJ7!1SUYk>{G!4=s2sN*e^+4w80_q> zK;I2QT6wc`MtwoiG2tHi8Pp&;OBW*uk<|R zl(eh!cAl62^sBhXDJ?QxJIcpM5ee;8D~txc>%fS)z47h;V*%o1F(axF`JA>BKLb1w zLAz&-UIDjOmBv!e0l)+vy3?xDIsBJ?e%b)X5_Mzt@(cLGmL%)#>}_vcwTqVY6NCBC z@2gc+EOlg5pd%B70Lr~lEQdm0=McEO!LC7vfM#3D&RpZ|`{A61hYsY+GK*{JbB~F? zzTzU|DImA6L;b!S+85g18763qIM+f*mq$#}H~nm#*S6>MITl%XX*0Y&WRhbR7Yzmk zJwU4aQGEQrh57}8tHtZ2B(29z6~TphtW4VFO^J_&>D@5LLZvve6?~_xvK5vI3S9y8|2jJ>=bsMKY%HWmL z*_0X^M)Bwn6CBq)}YTYa|nd?TmA&~sD5v<-W|*1<|$n0@_|QB#zT|2L%+DY)VX zU-Bh&z5oJ$d6H246 z79{gwVN403ip!)8RsI+j!ADFn0A*6j2@fY}6svM^BQTL~p4i}TXc^e&yVWR|=FB*5 zPnJzygJB+7$rFMjTQD(`H#Vlp&d!D)0s?_yw_%G&pu+oDXd}f*WQ8cAcj4tiW7lU= zyQV=Q@~)JFW+Iur=SUwubm8eqQ<$(NKK0FBE}rVp5bbbqjM3(qI&`SW*Sm*|@|!vn za7&Oa2FVEsg2CZ71w)`8CI7bFabZyFjdXQ2U%*P2d|xUSXdd1M!bmYRvgzA?Vh7AM zyYl^}4D9=cP-j7Dqvt2t7R4wiYsSSZQdy~8mhVGD3)%4>9p{D_+i{jy@kb>`nJZwv zb#q?U@1ffKB5tnQ%hB{6BT`C=uW$rUg(dhfRwq&43rMdQAAq0noZFGeha_V_=!G{uYK)6XZ(RDTX1M|M}C>;7`Mkoa0XlNtOCmN@27>c}-ST z6-I8s3=O*uS9KbFrRf_dryr}OZMWkA`r`tr!F|*bXL6qdKK=3+ z%yJmqH;L({tgq>_E-%=%DqA+5`uV*-MVCr&nyz6C=CcMmS;FQP7TS$oj&}dmKbIDQ zh86;$9?+u76(zIw@dCq^9T zt6oTn;JMBaPL*blzRTkA)vXLCRA9$jwURe=L;dAvmgKEq;LfdS)61Y%85*0)X(-|I zw)H(04k6x#l`Nrd)e{5y(Rtj7iD3j?=fpLW5%+NL;c#0*Py!$NFmuUn`O{qO#ITE( zGtIA(TG^SHP@%g%5J;pqTj&UBXj(-0%-)wJR$6;xo;g%*ZsxVYA(94HA!BO})bxGk zBmb~hF}?bS>No=rP+6=E-=3#&(&QmeNFYSC&x z@?n>epiPGgCgq!Oc?AW|kUli%<>lI>d8J8f!@GdU9!4;Qby!*L8fp4eBNK{%*uF=X z5%dEYj7po;r!Xe`o12(QDW<5=B|47_ECzE?70lzaSB!L3GZPWGezb`R372o5O{P1C zM?M9Om$8E*v863YF~D7KH?>^%gybVPPf2rSE!gkH=@Zq3#&m{9R9O0B(BiUr7# zrx^HD9bh_q2FVl}&hzR488P5?<(Ush0~fxVzpteOmS!DEr!HN(0dR;g`6wY2|q;Hg8LoNf2E zI>7U@tE&>HlVY%3?8Vz(qA8vz-whdwHSokBiDK&Q>9YOuxF@cOSS<7kCder1gYQw} z+L>H4E?(b@Y0s!v35Oq9g4g{$ya0w8vEY6)>r0~d?&#}@|79-X_-BldTdLYHHmzXj zv5rm_DKT-R%T|`N!{A6C4;#uNjADnrBXwYLB;_Ck`Qw^gHyVzYX;lQo$y>7TS6e61 ztB8$RoTPB5*yw?z7yo{S*|BJLdTd^K@W5iwZ)<1d)2_Ir6&(4@L> z9){$Zs9M|FmRxU7y!i)Wmq0Ps@a}+Z zTzgnr7LD(>s)&)2u8FR#rL(KVQydI`d)*sXU9JCv`qaf>Yk*1brdfF04fvW z`n}g9%>f~363-rPA5^*i0niBgbUte+P)=7jCH}juE;52G1`J`8cL^Ak9ageihsX!s zF+RL2EI)94>A_N_2rUtTQfC#~_O3_hQ*WOyQ|W~uYhu|SSApvXm1KL$@9kH^ga?=G zb;eoP;dG12uB1+O*atErJqMq>YqI~OUJ>!JJcW{k{*hXDL^F4@@nB8@8}bz4+k zX|RNT`65I`MYXiJ2xC=ISvQ<}NQ~+gu-5xKu=K?SXQg&0N=u+zPs-|#ut{UT$7f*d zeNX1vMQ#0Sg$W9D2DEP=Iw2tvAcj~~QA)Sg;Bj;!(vQm^;M9Rp6mwo5wq9x5`{cwR>JHwOzcs#N7r^T(l=pwd-~ zl1S)SzWm;ekDGlx8pfAV7iIKZ`fRQxg2<(ZA;i9Lfw*_6{-=Z6TDJ(8MKHnwjs;TCJnV+qgi)){{ zvTGPVFLqSyBR5UPsWW!Lo}ST|`j(o+mp@pfkYJ3BLQeQ#Z8RF4EdzR8qT+DFZJA=- zruPn^1E+JvG<;2S*~6a_^X`b*n?fTQ$rUZS?}v4}@y9TEIGs8}Oq?MxxhJoSY!5lP zMih^RvSBrpV;lB18Ia@#oBGoX-dfe(S6N7M%`PBSg85K|hlhKwXGoIE1Di&dm7e%J zx#cgUZ3v*z!@$p<9HR^?twH4owgOJDX`>$%{8GQ>!@}7qOl$h>kk{$8-df7P`v^_O z3bp zmY+{$rwst6W`dOUY%vj$Ek4Kqu7d$Ex4#d8f(zQ`dKO5vZh~B0mA}^pGB6wFCT81B!DFEGZNeu<|p4i_q%_f(r@AP)@3i~)^jZc zr{-#JgbL2_u{XC(nmR;7R!tcX%gN@gmkTd|ODe}65X#dGfLU7koh!oS$o-9MMxY$F zURK$X^%7{e;sI11Xh4hnuU~OXZV?V(kTy+5bFbV5qOskkiROrk)F(7q@aYBIC7H1^$Gy2TI%wzUw4_7`NH_R znS~dY+@h?vydU-4QdqIEs%&CsDMX&TMG>2c3?CC+kP@FvddW1%wpP*4EcQL>Y z`P*K+gYj-w`xiU-{;;x$_>It624r(Z=TQ-@-e;Wo(YrieOCOGaX+k3a&?WY3X>0d= zg+om%D=PuRK-I<7Rpf=X_S7cW@Hc>cy6_Uv>#Jg~lmv^N`Boni6v0glBqdpKMsijb z7Ia9i+Jh?BFkbd8eKC&aEXAH`da{{Y(7s3FH3d#Jq3=(@CQ_#1Wjhl6788W|ygR0B}B zcbtBk*8T5mQ&k;qFeSw@Q}J6{w2vZaXLX#8Gk;|`yLh(OS?*2^LBPuk0-W3W=b5>= zVpvOy7abtwV)^*^qyjBm+Bu+wwmv*O902xReL&`T4l3o&7q@>mTr&W*g5d3ob!xlZ zjOc#1+I?XhR9khWl*(4)B}Z05lBV3b_xQW=@Bp{VDd9!$$jHNFfVA{60PN}>05pq( ztU^pcFNyMZMhPnd(b@SFkF4Kg8@tM**2s)c3O~I-Htgd-OoN;JhkD4I3q4x{vH(Ark=D1aT_!d zfdp|2Qm*?s|1R)JG*(oMUISoyVhrPe02Epo!bWMoj~D{4QjHp(A-wIER(#dJzB@vkjyIGEZ&;ju3>ss`%`1rAO0VX5eweX0UDvfYCxA zf6jJOuYPh=1?K3e9m<_HV$rqE@k2>&IS8K0AGlw4GMny zGPMEf!a~;cx}qYUXjUEwdop!=yy|doZv~&Y_?owjjQXkQL2JPWA(vGLn8D3STZb30 zx1$vE=Ai>Bqo7GXb(n7=1~?Pl2D8he=(Rql%Z&+8e|Ja>&=Bqpoj$!s{*q!;m{i+# zKE8Q)4W46hZd=Au&=-4ib9(S%=CgT!)}b80GBNS-)d6ilPb?a~SJh(T;sK|hG>X3h zwg6m4U*8p-LWc%QwD2az1E4|l^nK&o)c5mvsDF3f(+S3d2r;HHCXs~)=kcxUI9OW57_=FjA;0nfE)z6mkijrxFYIDEx>2WTp0+$-$nz7nX!WV!HJTf zB*6r0o%2ycAk;hB8j46A3us#^mQ&#I`m{Ty>>Jj57MjMEJ@n#3dd#zy^IBVjyn`Pt zS0SJwVT0rzN@HJ6t7~YiY;XH4jT!lDBm;d$hprVCteu?rKR%xZ?|NCZR(7lXK!2x+ zg*y?6nJx8}n)$r}CI-5NiOI&xvS$$G%$`m@o|)1Y7IvKNA>FIbzLEF&&<(?|ah4+d zVK!$p9y^$Qf_6W58mp^`uYjG5U)?J2T~^k7aMQYjOaFYHWsFNcmXZlVG=#L#?+9!Q zRno2p%J{e-=wNQq8j3`=lLzeWP-qieR~YLG5t|I>zczCj1@=KZ^iddOS+;NHH^Bc%)`^DuN^u$hh{NXZ> zRRk)ff3H(Nu#5F$^9L)gI%>(l`CHshsZ)A-!UDK?p9^#wh-}^0rkpXu&`C@P#MYn5 z+`fGtbpTv&Go>*w$!-bpLev;3+3VKcapj~FStnIp|J<}+N!Z^S&9QeqTwXlwjY<9O z3t#xO3raqa`*nfMD4meZ0Eu*&2{C{sVL`ruwAfm?(BfdPTQ+)-+HgH!=7s#K)i6~Z z&i@&Vf?iDww7Z7o7}aKB2*J`9sl<q2%hV735@OYHRc&6Oz;V;G4> zCxfkf1ix`N+0UFb%}3MMJ7fWC2`O^Jz+vm`X0mMhv>_i+{*sZhV}Zsx6w=+( zGuCJ`XB8Op^X!?b{JuqF0he1u{YNG4ks;wogHKW}`s9))vyIAG1(R5lxPMH3o^IPg zPq_NRiH^Mp7$j(c1tcUGK$yK8=L@?k7Fs$2xL02Lc^K7bnQ{aS^8dmU_NS*7xnZ{# ztMogFOhxv0GRpFQlp)bIzcWqQA#LLszIX7V@k5Z1)6NGjLy-f(>~YBf_@hPN-G?G+ zf9s56kAp?Jznc_J-KIk^V$NH8VOqHArHL?tPANzKsqSkraJYbCP=#fxW{Vu@4`~y?pXbo? znt^l)2?iM2@vgt<+T>k;gYN;}xmbOaOD8>qqUHSBEV0q)Pvt4>O<*q3T3q3p;e>|L zy!li6%NT5xxw09akt~Ac#zT~AfDs| z23Mcv>E9Yei^NKwPhx=@0+V& z1ei;D(K}VzpZ`>aMG1#H^9-cjAut`GaMoBc@LWMmeiK~!-RQG5YS?29mcHP=9+zfA zVH}e=BqckT!_&yC^pAWhI&)1`G4n2#hZANes|cNo>dDd=#dMeo&2k8f>M^NOD^HBA z$}Q6Sxouza+5DNjaF(ZD5+j*9989kR>DSN@Il!IhR2PNN^G zyP{f+#9nUvKY1{FA5ZTdl@NuBO5aNCO4c)_)uEnRJ1#=#GYkhfP1O_)^#CzTzzjr< z`Zc*gIVQ?fsIl9CxELgvYxdX^$#+;td}sbl!n`;oXz*zmv1{^iI>S4yql;S+w4mqt zo!x`ztg{?$`1We&d;MJg?Yt~GzLKToJ0|;=pnU#_DTVFB3F1X(C*Kk~VT=|!8+pkw}3{RN=|3os^a<*;d(TD!D4@KfuSH76jx?nku$rP_{NAZq8_t|3Whk0 ze0$;W-FkR>^xjbfm*MMJYC+Ez7va$&eU#4?74xzQ!5Mtn?EV0ya|IY+s@J`#G@c+S zeok#D#B=+yWgu0*CE$b_UF)w+pkEeZ+3CG0_H7z zLR^k>X?l;B9CF@H{UF^E-(?)mM6NpCd^`!*VbcO%`uKW9Kvwy4vvAZQlj} zQsZpjod^85#4uYZdx$|C%F-54oML$)EvR|UkF2$uQ_xJUnM+=jE-rElx=xcgI81sz zjOE}31?SQ9TF_@u25Z4FXd^f8xT0I&XrRt%=Q;KO!LB@n`VXfvt#!Kh~Q23J~W_5d!b zS|95@C&5mnx&Pqj*|1KT4tx+k>M?BEl(=MNmVPk9T?2bax_N{bMEq__TW!$@X;OT!8 zw{ShEpX7Vk^gyHaiE0ccoD1ME&dWvlqwb3oT?zopy=)@x>AwUpH(R3+*6?C`-@X^M$mO{`(D(X6qRx>> zcIJEtGX~194uJJTfvX+6PG#n8`lKXrZd*^_kCvRJ#Qw zXTm*RD*qS_2p2KjjDJ~Xv2f{KduiFzvqkq@?DKUTj?+gLTc&ZqE#Aw6am6&86&qFh1?pGMjxTMWxRJuHh-{s?NH^v{2}!>0M;ODAcH`H|v9H z-zN+8gnMsWuNb3S0&A?#=>=>Qi*a0F$`Lgi^IrU~TH7rK)nisySGDJtnzgJz`#MH# z?hVAC^iVT)5qGr(0ZJ5pEi@$WM7K#GT+O0B3FM97x2blSx7db^1W2tJ-$ zFSJ@79Ay<`O9ju+QyIJ$wYK~k?aE(nf)AC91?(rBcTXFOx&5lO><&6Z(8mCpxLMR= z=LvvI&D7bDfKH(pIFUE2F&~$WWQ%72PbarIhenK4E)CZ&-&yo3&6FE4r&Y)#xQJzx ziAEe$H{CYBtxWIlO;zlkbS?q>3Q%nOmG_zjJWj3wTA$SKA-7P=xY#2!HfTd%A6G(j zw4NI?FE5cDp5!;aQca7Zfvb2BLH&L=%=|u$js4N6)!yc_lK)hxdBL%~zR7@V&9lYr z{NQ@KOxb$#rrF~F_f1rk*xQs3%{!3{4YVbiFm=`5sHnQ>zJxJa_@CWbAaiT>qfoIG z0NBNlh!e;}m9a5}+>;wSFsRsEAJhmL|9D-{bK!!tr+N~E1{=R7p{jmEMY0k@tFLYTdn=I0y-D@5}4+k#VH)P6> z{a8Pz>$RMZ`;l|U+aSJ>WKH5RGp812ecKS!AtLGG#%Ew=o*n`n8C190#AqcaP=rT7 zwB=R=Wn#xpawdh;y|o&{fkA>#?f#cPtfAWFx_RBGQyCRCFu60=$UUVmKlrZq;1Y3C z529K{SMP}U>CP6SjS&(uZ}~i@q-V;3W*-o}9m=!5KYaoPl3wf7XF#+67eHJWjQwqW)?%eka9_i_Wkjorr(^8B5Ki#jO)maX#$_`5$!IzBh&{8xOkdZP)Y3pC^P+aV; z7B=A&5~u4m3PM?yYyGq;jHvaPgGXqQfocE{JYcb41_eFr{aPj7vIZyaUYL>zA!x4&rWqK%x?H`g zIleLQ&JaAf&}6)Ka4_6D#~s+Z6>6>#!pC@(zjfU4y1doRVuLQj5OOdksr)eb9qXR5 zjez~d6neG8oB%)9zc3K^4II*)-Gy;7ajV@##Si>-d~R}Syf+mQ-ou4 ztCe$#NutXUM#Q$}nuI*!Uyj454v?f(37^?J+_`_B3>QX$k$mi7Vut@)Ay~G5d6zqH zi=>^<|M?T*#kV>uE26~&jn?&``!BPkC)(!RY1icg-vsHc9WcrAFOQm6jA z{$Ih385-*{zjc+%sgt{P8$ZOCu(O9ymT45Otjk!)Q|C{r&wqBN<{fg)f7qx_T(28rVBvU4N6?pRMp%87N8>Yk`3jbE}(af;e z^3aT3Gwg0fn@5ja^%@|Y3?}WV0Y1MG^LFjDGzrSD+PaH2&|pIAd`@bw zzlJ9^iWazs=}Z(WN&!0OJV3F4rH&9Jnvg4hDmrwz|_^GBp#n z9&r^GNgumh_+kv_;4JNjxJs*)k~Y2Rim7G%d2-?=lG!fhy3Y3=JG5X*P;6-L_4wel zn@~839TOXye4Nq~(!bB;)e0q1@c8yH-Yp~L5ICWMh z&5o;*6Fi%gYbU5XPZ&>&5lM0TAbd<)=G7uw>sctrt*<&**3_A`YMX+k1-)S|QULve zx-8>&-9hk((X2Ac0y{-Cda+EdZ*DZ5y3Qg@oWBr@w6`hdj~K(z>33TyyoD*R8FY`C zGzmiZ1PhCLj@GKr?1TuylY^DXvwi*98QT~Etp!ZpqYOZIC=~Cc*J?QKBuseCn4{kYJb*_I-^ym|m z?15}=6Tw;LT?k{dap0O^-S_ew-6;QvkdB2DEJ-ms^O0{>g{Ca5WHsjY?WyH6i!Bmb z4Ws=q*$(pe3qc4#?~)J}-zTM(0brKDhfBnXI@~8upT5n?qWXo$*pK(S6;nYHeF$jV zW36z@=4o;Bs1AtXF{p+=N|3r{ZeJTuGTkP9^#elx3s;36Jps$0Yq`4m)R@Pm*-8Fv zJksQ+8uk^1m;mIb1UigdMs{W1)Z2l_pL!RMqi|TrUWgN&5owk|tW`TdjG2r{IICc$ zMwt2Z=giy=a)9z@NL~L_8^BPMU%7H(l%Rj)Hb!VI)IcX!7wNSlo#flTFhaN=>QTnT z``s%OI!Yh@ov>4AZH{~WPx(nQPA2oihiev>#~W)CrT?A#R)aZKLyP z=P23&&KJlOy5g0|wlcQ!g?7GcOMp1>tWVIDY(%~D`7QekYyqU?(psC*fXCHl0_A9x znPtdCQuUcz)XNQ;uN#9AnScm<G7`rufs@a|I-kR&fSpToC9Bv zBgnY7{P?(h>>CbrgD#pbgxsS0DTc33CLg3)&}i?Fs!%sNLukc)HRGN=ft>xV8GaB- ze);&ZFw=*k#?SZ2K~a|oA1O#=uxF0@XJ)s{m`(Pb@LST1Y8Ugb{=vWzvFt@Ob}l_C zt3IRVF$oU%l^0pVL?<|>m1wtok3_KL0sZE&*phg3HtXEzf< zvy`>ZlmF#(C&CANh zwDRr4R7J+SK6|_pigk)LtfpD>XYa4GKdR{8Ycb#==(zJ=nNju`PRqwGLr8O(3MIO!w zBFUw7H$lB}fv4T)R&`F(yyPZ8{+m7i-|<%fR0mqM?WB(0^&j|4qjrB&b)Q-Gz)Y{e z?FFG{%e37+9DTqo+2(d9*zIaD{wrCu`_kqMgt&wHe-&)mBg?OcUr3%qzLn`LCBYXc_@`^S3VBDmM?{&f5noPv z1mYgB^6_0NR2hxk(3t%CmIw4__2T6Jy=z==3G)?|jd9&a8@*m@*3z z>YbA+-dJ)|`krOgcafABRZL}r!SpaDrMPb$HL4>9$s5u58lMX7!c(4`B5+7PL44|l zj(h0?Ddt=TN8rUek&_0cmD2lRu^%1CPMn+QEs%%*#yE8;02_mVdHdchE*X3L{&dw< zw!Kw4pOs#}3J>X!C#cXTMpQ8`W@Iyi=23ViA;YJ_N3*X}yfdy|HpE^3+2s$y zii(f70%Js5+J8^4cq`xq0%;rSV1Uw~|GiM=b0d76aZ^`HLx-3ByD zc5A(x6%=Rk^VQ!d^88oUXtyY>Wn)wX;f?lW@S7_JF~`_h0_UBH2SE0<2op6I136@R z4%jz=%hO4jWLaTo5_`0{uAJ3oqk$C}sbf!!Ni}q76fUWL%HvZt(?jg{TAHnv`C1<&tPp4K}Zas%zVu86olleSPTn~?H`t^PoDI$Kh&SEWeX$T7TYmVBZ5pi?fzz`FFRZFte~IDkyYPhVj0J zFCmvrG6V?gsYOn!{9K1=-QHkMjZ7i9&pM_VSN#lc=tgT5)*Sp&$UiD2lfnny7Fct> zJU>!{nB#*{nmTB~|MoaYKtc09{Vorsx^f;dXDvkLOJi%c*%>A3!n`=9TOiC$~3f7AxGFC6JVGViq-c;BjG$Nr<#Na((00`fBWuO(TB- zuJ>GG@@xT!i#2T6RmIKSMlsq@wqb@A|6X34O2S|0`U*aVgm*{8+~#xmSt#v(y8J@r z!|Qa-8|6nM4g$L_>t`YtYn@JHqW;P^$IUi~p6q<`u3oFO(JTg4U|HpRp!eAN3@sjt z(h&o*=#PmZTxGDCi<_GiP2wceL_%0H$ zCF$|vUw0381djHoO_Di2I;NO)e;iGYE*Oo`163{TgV~d9AC(W7>3q%3@02pl)4=nT z6A^AqqrfGx7$iYhtYBR!KEjf@c{{XcGwpnj=AQVaMXDpvt9<|@H!fs?0U*Q=C>&r( zflZnR)4z92FascQ2udr#93K$R>%mI!nE|*L#zEZU6m|GnhjX^86UCu!8zLMDp%@r#)#2fJ^h<-msrkE-P%S@Gz7=!QGhGzTUC&Ui@p4jH*Ff$`RH)yceo4s>S zi4#Hzvb)!pC}N2F?vx6}^Cy*f4o`rF+A$4?dwdYEM94R4^My3nO*<+A+Ly2C_{Rey z@GEycb4r-i$WK-*!axl_G|H=77{V_(&?Hr7TkY= zmH<=902Cerf4Pg`VDntl-sT=0WNUktg4jw?FH#~@R2F-??b+fYL`(WW{R61??V$n)szRv3q1z2w*Q_X6_E4gQrn!sPbGIBz-E9xmkqcw_ZW5w!4wT?_g~vi zm=D;F9p1=|?tlLWBJR8b=kh_(^-~@GTSNLWynVAku)tta8w_p0*v1TEzLzYh+ExlN zi~a1w=26-J&KfLv^wL-e}Byk{ Date: Thu, 2 Dec 2021 20:35:21 -0500 Subject: [PATCH 091/138] +Add post_product_[uv] and post_product_sum_[uv] Added four new routines to within MOM_diag_manager.F90 to write out a diagnostic based on the product of two arrays at velocity points, either as a 3-d diagnostic or a 2-diagnostic of the vertical sum. Doing it this way both simplifies the higher level code and promotes the reuse of scratch arrays for diagnostics. In tests that use these new interfaces, diagnostics are identical to their previous values. All answers are bitwise identical, but there are 4 new public interfaces. --- src/framework/MOM_diag_mediator.F90 | 103 ++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 374f54548e..eb24c994f8 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -39,6 +39,7 @@ module MOM_diag_mediator #define MAX_DSAMP_LEV 2 public set_axes_info, post_data, register_diag_field, time_type +public post_product_u, post_product_sum_u, post_product_v, post_product_sum_v public set_masks_for_axes public post_data_1d_k public safe_alloc_ptr, safe_alloc_alloc @@ -1802,6 +1803,108 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) end subroutine post_data_3d_low +!> Calculate and write out diagnostics that are the product of two 3-d arrays at u-points +subroutine post_product_u(id, u_a, u_b, G, nz, diag, mask, alt_h) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_a !< The first u-point array in arbitrary units [A] + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_b !< The second u-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask [nondim] + real, target, optional, intent(in) :: alt_h(:,:,:) !< An alternate thickness to use for vertically + !! remapping this diagnostic [H ~> m or kg m-2] + + ! Local variables + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz) :: u_prod ! The product of u_a and u_b [A B] + integer :: i, j, k + + if (id <= 0) return + + do k=1,nz ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB + u_prod(I,j,k) = u_a(I,j,k) * u_b(I,j,k) + enddo ; enddo ; enddo + call post_data(id, u_prod, diag, mask=mask, alt_h=alt_h) + +end subroutine post_product_u + +!> Calculate and write out diagnostics that are the vertical sum of the product of two 3-d arrays at u-points +subroutine post_product_sum_u(id, u_a, u_b, G, nz, diag) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_a !< The first u-point array in arbitrary units [A] + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_b !< The second u-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed) :: u_sum ! The vertical sum of the product of u_a and u_b [A B] + integer :: i, j, k + + if (id <= 0) return + + u_sum(:,:) = 0.0 + do k=1,nz ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB + u_sum(I,j) = u_sum(I,j) + u_a(I,j,k) * u_b(I,j,k) + enddo ; enddo ; enddo + call post_data(id, u_sum, diag) + +end subroutine post_product_sum_u + +!> Calculate and write out diagnostics that are the product of two 3-d arrays at v-points +subroutine post_product_v(id, v_a, v_b, G, nz, diag, mask, alt_h) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_a !< The first v-point array in arbitrary units [A] + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_b !< The second v-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask [nondim] + real, target, optional, intent(in) :: alt_h(:,:,:) !< An alternate thickness to use for vertically + !! remapping this diagnostic [H ~> m or kg m-2] + + ! Local variables + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz) :: v_prod ! The product of v_a and v_b [A B] + integer :: i, j, k + + if (id <= 0) return + + do k=1,nz ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec + v_prod(i,J,k) = v_a(i,J,k) * v_b(i,J,k) + enddo ; enddo ; enddo + call post_data(id, v_prod, diag, mask=mask, alt_h=alt_h) + +end subroutine post_product_v + +!> Calculate and write out diagnostics that are the vertical sum of the product of two 3-d arrays at v-points +subroutine post_product_sum_v(id, v_a, v_b, G, nz, diag) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_a !< The first v-point array in arbitrary units [A] + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_b !< The second v-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + + real, dimension(G%isd:G%ied, G%JsdB:G%JedB) :: v_sum ! The vertical sum of the product of v_a and v_b [A B] + integer :: i, j, k + + if (id <= 0) return + + v_sum(:,:) = 0.0 + do k=1,nz ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec + v_sum(i,J) = v_sum(i,J) + v_a(i,J,k) * v_b(i,J,k) + enddo ; enddo ; enddo + call post_data(id, v_sum, diag) + +end subroutine post_product_sum_v + !> Post the horizontally area-averaged diagnostic subroutine post_xy_average(diag_cs, diag, field) type(diag_type), intent(in) :: diag !< This diagnostic From c0be5d3d32dbfe232fe22ca38e8192465f5f256f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 2 Dec 2021 20:37:22 -0500 Subject: [PATCH 092/138] Use post_product_u for momentum budget diagnostics Use the new post_product_[uv] and post_product_sum_[uv] routines to simplify the code calculating derived diagnostics of the momentum budget in step_MOM_dyn_split, calculate_diagnostic_fields(), horizontal_viscosity(), vertvisc(), and layered_diabatic(). Also relocated the units for several diagnostics to the same lines as their conversion factors in some calls to register_diag_field, to make it easier to spot diagnostics with inconsistent reported units, and removed variables that are no longer used. All answers and diagnostics are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 390 ++++-------------- src/diagnostics/MOM_diagnostics.F90 | 96 +---- .../lateral/MOM_hor_visc.F90 | 120 ++---- .../vertical/MOM_diabatic_driver.F90 | 24 +- .../vertical/MOM_vert_friction.F90 | 179 +++----- 5 files changed, 199 insertions(+), 610 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d0a324f96f..d3ad0a0a92 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -14,6 +14,8 @@ module MOM_dynamics_split_RK2 use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_mediator_init, enable_averages use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, register_static_field use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR @@ -344,36 +346,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. - ! real, allocatable, dimension(:,:,:) :: & - ! hf_PFu, hf_PFv, & ! Pressure force accel. x fract. thickness [L T-2 ~> m s-2]. - ! hf_CAu, hf_CAv, & ! Coriolis force accel. x fract. thickness [L T-2 ~> m s-2]. - ! hf_u_BT_accel, hf_v_BT_accel ! barotropic correction accel. x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - - real, allocatable, dimension(:,:) :: & - hf_PFu_2d, hf_PFv_2d, & ! Depth integral of hf_PFu, hf_PFv [L T-2 ~> m s-2]. - hf_CAu_2d, hf_CAv_2d, & ! Depth integral of hf_CAu, hf_CAv [L T-2 ~> m s-2]. - hf_u_BT_accel_2d, hf_v_BT_accel_2d ! Depth integral of hf_u_BT_accel, hf_v_BT_accel - - ! Diagnostics for thickness x momentum budget terms - real, allocatable, dimension(:,:,:) :: & - h_PFu, h_PFv, & ! Pressure force accel. x thickness [H L T-2 ~> m2 s-2]. - h_CAu, h_CAv, & ! Coriolis force accel. x thickness [H L T-2 ~> m2 s-2]. - h_u_BT_accel, h_v_BT_accel ! barotropic correction accel. x thickness [H L T-2 ~> m2 s-2]. - - ! Diagnostics for layer-sum of thickness x momentum budget terms - real, dimension(SZIB_(G),SZJ_(G)) :: & - intz_PFu_2d, intz_CAu_2d, intz_u_BT_accel_2d ! [H L T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJB_(G)) :: & - intz_PFv_2d, intz_CAv_2d, intz_v_BT_accel_2d ! [H L T-2 ~> m2 s-2]. - - ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], - real, allocatable, dimension(:,:,:) :: & - PFu_visc_rem, PFv_visc_rem, & ! Pressure force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - CAu_visc_rem, CAv_visc_rem, & ! Coriolis force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - u_BT_accel_visc_rem, v_BT_accel_visc_rem ! barotropic correction accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf @@ -400,8 +372,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo enddo - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 ! Update CFL truncation value as function of time call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) @@ -918,261 +888,76 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) - endif - - if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) - endif - - - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - !if (CS%id_hf_PFu > 0) then - ! allocate(hf_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_PFu, hf_PFu, CS%diag) - !endif - !if (CS%id_hf_PFv > 0) then - ! allocate(hf_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_PFv, hf_PFv, CS%diag) - !endif - if (CS%id_intz_PFu_2d > 0) then - intz_PFu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_PFu_2d(I,j) = intz_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_PFu_2d, intz_PFu_2d, CS%diag) - endif - if (CS%id_intz_PFv_2d > 0) then - intz_PFv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_PFv_2d(i,J) = intz_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_PFv_2d, intz_PFv_2d, CS%diag) - endif - - if (CS%id_hf_PFu_2d > 0) then - allocate(hf_PFu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) + ueffA(:,:,:) = 0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_PFu_2d(I,j) = hf_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k) / up(I,j,k) enddo ; enddo ; enddo - call post_data(CS%id_hf_PFu_2d, hf_PFu_2d, CS%diag) - deallocate(hf_PFu_2d) - endif - if (CS%id_hf_PFv_2d > 0) then - allocate(hf_PFv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_PFv_2d(i,J) = hf_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_PFv_2d, hf_PFv_2d, CS%diag) - deallocate(hf_PFv_2d) + call post_data(CS%id_ueffA, ueffA, CS%diag) endif - if (CS%id_h_PFu > 0) then - allocate(h_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_PFu, h_PFu, CS%diag) - deallocate(h_PFu) - endif - if (CS%id_h_PFv > 0) then - allocate(h_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_PFv, h_PFv, CS%diag) - deallocate(h_PFv) - endif - - !if (CS%id_hf_CAu > 0) then - ! allocate(hf_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_CAu, hf_CAu, CS%diag) - !endif - !if (CS%id_hf_CAv > 0) then - ! allocate(hf_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_CAv, hf_CAv, CS%diag) - !endif - if (CS%id_intz_CAu_2d > 0) then - intz_CAu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_CAu_2d(I,j) = intz_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_CAu_2d, intz_CAu_2d, CS%diag) - endif - if (CS%id_intz_CAv_2d > 0) then - intz_CAv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_CAv_2d(i,J) = intz_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_CAv_2d, intz_CAv_2d, CS%diag) - endif - - if (CS%id_hf_CAu_2d > 0) then - allocate(hf_CAu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_CAu_2d(I,j) = hf_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_CAu_2d, hf_CAu_2d, CS%diag) - deallocate(hf_CAu_2d) - endif - if (CS%id_hf_CAv_2d > 0) then - allocate(hf_CAv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_CAv_2d(i,J) = hf_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_CAv_2d, hf_CAv_2d, CS%diag) - deallocate(hf_CAv_2d) - endif - - if (CS%id_h_CAu > 0) then - allocate(h_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_CAu, h_CAu, CS%diag) - deallocate(h_CAu) - endif - if (CS%id_h_CAv > 0) then - allocate(h_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_CAv, h_CAv, CS%diag) - deallocate(h_CAv) - endif - - !if (CS%id_hf_u_BT_accel > 0) then - ! allocate(hf_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_u_BT_accel, hf_u_BT_accel, CS%diag) - !endif - !if (CS%id_hf_v_BT_accel > 0) then - ! allocate(hf_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_v_BT_accel, hf_v_BT_accel, CS%diag) - !endif - if (CS%id_intz_u_BT_accel_2d > 0) then - intz_u_BT_accel_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_u_BT_accel_2d(I,j) = intz_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_u_BT_accel_2d, intz_u_BT_accel_2d, CS%diag) - endif - if (CS%id_intz_v_BT_accel_2d > 0) then - intz_v_BT_accel_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_v_BT_accel_2d(i,J) = intz_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_v_BT_accel_2d, intz_v_BT_accel_2d, CS%diag) - endif - - if (CS%id_hf_u_BT_accel_2d > 0) then - allocate(hf_u_BT_accel_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_u_BT_accel_2d(I,j) = hf_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_u_BT_accel_2d, hf_u_BT_accel_2d, CS%diag) - deallocate(hf_u_BT_accel_2d) - endif - if (CS%id_hf_v_BT_accel_2d > 0) then - allocate(hf_v_BT_accel_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) + if (CS%id_veffA > 0) then + veffA(:,:,:) = 0 do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_v_BT_accel_2d(i,J) = hf_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k) / vp(i,J,k) enddo ; enddo ; enddo - call post_data(CS%id_hf_v_BT_accel_2d, hf_v_BT_accel_2d, CS%diag) - deallocate(hf_v_BT_accel_2d) + call post_data(CS%id_veffA, veffA, CS%diag) endif - if (CS%id_h_u_BT_accel > 0) then - allocate(h_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_u_BT_accel, h_u_BT_accel, CS%diag) - deallocate(h_u_BT_accel) - endif - if (CS%id_h_v_BT_accel > 0) then - allocate(h_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_v_BT_accel, h_v_BT_accel, CS%diag) - deallocate(h_v_BT_accel) - endif + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_PFu > 0) call post_product_u(CS%id_hf_PFu, CS%PFu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_PFv > 0) call post_product_v(CS%id_hf_PFv, CS%PFv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + !if (CS%id_hf_CAu > 0) call post_product_u(CS%id_hf_CAu, CS%CAu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_CAv > 0) call post_product_v(CS%id_hf_CAv, CS%CAv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + !if (CS%id_hf_u_BT_accel > 0) & + ! call post_product_u(CS%id_hf_u_BT_accel, CS%u_accel_bt, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_v_BT_accel > 0) & + ! call post_product_v(CS%id_hf_v_BT_accel, CS%v_accel_bt, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for the vertical sum of layer thickness x prssure force accelerations + if (CS%id_intz_PFu_2d > 0) call post_product_sum_u(CS%id_intz_PFu_2d, CS%PFu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_PFv_2d > 0) call post_product_sum_v(CS%id_intz_PFv_2d, CS%PFv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged prssure force accelerations + if (CS%id_hf_PFu_2d > 0) call post_product_sum_u(CS%id_hf_PFu_2d, CS%PFu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_PFv_2d > 0) call post_product_sum_v(CS%id_hf_PFv_2d, CS%PFv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness x prssure force accelerations + if (CS%id_h_PFu > 0) call post_product_u(CS%id_h_PFu, CS%PFu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_PFv > 0) call post_product_v(CS%id_h_PFv, CS%PFv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics of Coriolis acceleratations + if (CS%id_intz_CAu_2d > 0) call post_product_sum_u(CS%id_intz_CAu_2d, CS%CAu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_CAv_2d > 0) call post_product_sum_v(CS%id_intz_CAv_2d, CS%CAv, CS%ADp%diag_hv, G, nz, CS%diag) + if (CS%id_hf_CAu_2d > 0) call post_product_sum_u(CS%id_hf_CAu_2d, CS%CAu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_CAv_2d > 0) call post_product_sum_v(CS%id_hf_CAv_2d, CS%CAv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_h_CAu > 0) call post_product_u(CS%id_h_CAu, CS%CAu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_CAv > 0) call post_product_v(CS%id_h_CAv, CS%CAv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics of barotropic solver acceleratations + if (CS%id_intz_u_BT_accel_2d > 0) & + call post_product_sum_u(CS%id_intz_u_BT_accel_2d, CS%u_accel_bt, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_v_BT_accel_2d > 0) & + call post_product_sum_v(CS%id_intz_v_BT_accel_2d, CS%v_accel_bt, CS%ADp%diag_hv, G, nz, CS%diag) + if (CS%id_hf_u_BT_accel_2d > 0) & + call post_product_sum_u(CS%id_hf_u_BT_accel_2d, CS%u_accel_bt, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_v_BT_accel_2d > 0) & + call post_product_sum_v(CS%id_hf_v_BT_accel_2d, CS%v_accel_bt, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_h_u_BT_accel > 0) & + call post_product_u(CS%id_h_u_BT_accel, CS%u_accel_bt, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_v_BT_accel > 0) & + call post_product_v(CS%id_h_v_BT_accel, CS%v_accel_bt, CS%ADp%diag_hv, G, nz, CS%diag) - if (CS%id_PFu_visc_rem > 0) then - allocate(PFu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - PFu_visc_rem(I,j,k) = CS%PFu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_PFu_visc_rem, PFu_visc_rem, CS%diag) - deallocate(PFu_visc_rem) - endif - if (CS%id_PFv_visc_rem > 0) then - allocate(PFv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - PFv_visc_rem(i,J,k) = CS%PFv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_PFv_visc_rem, PFv_visc_rem, CS%diag) - deallocate(PFv_visc_rem) - endif - if (CS%id_CAu_visc_rem > 0) then - allocate(CAu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - CAu_visc_rem(I,j,k) = CS%CAu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_CAu_visc_rem, CAu_visc_rem, CS%diag) - deallocate(CAu_visc_rem) - endif - if (CS%id_CAv_visc_rem > 0) then - allocate(CAv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - CAv_visc_rem(i,J,k) = CS%CAv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_CAv_visc_rem, CAv_visc_rem, CS%diag) - deallocate(CAv_visc_rem) - endif - if (CS%id_u_BT_accel_visc_rem > 0) then - allocate(u_BT_accel_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u_BT_accel_visc_rem(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_u_BT_accel_visc_rem, u_BT_accel_visc_rem, CS%diag) - deallocate(u_BT_accel_visc_rem) - endif - if (CS%id_v_BT_accel_visc_rem > 0) then - allocate(v_BT_accel_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v_BT_accel_visc_rem(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_v_BT_accel_visc_rem, v_BT_accel_visc_rem, CS%diag) - deallocate(v_BT_accel_visc_rem) - endif + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + if (CS%id_PFu_visc_rem > 0) call post_product_u(CS%id_PFu_visc_rem, CS%PFu, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_PFv_visc_rem > 0) call post_product_v(CS%id_PFv_visc_rem, CS%PFv, CS%ADp%visc_rem_v, G, nz, CS%diag) + if (CS%id_CAu_visc_rem > 0) call post_product_u(CS%id_CAu_visc_rem, CS%CAu, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_CAv_visc_rem > 0) call post_product_v(CS%id_CAv_visc_rem, CS%CAv, CS%ADp%visc_rem_v, G, nz, CS%diag) + if (CS%id_u_BT_accel_visc_rem > 0) & + call post_product_u(CS%id_u_BT_accel_visc_rem, CS%u_accel_bt, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_v_BT_accel_visc_rem > 0) & + call post_product_v(CS%id_v_BT_accel_visc_rem, CS%v_accel_bt, CS%ADp%visc_rem_v, G, nz, CS%diag) if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) @@ -1551,7 +1336,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive = .true.) - !CS%id_hf_PFu = register_diag_field('ocean_model', 'hf_PFu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Pressure Force Acceleration', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) @@ -1583,13 +1367,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_PFv_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_PFu = register_diag_field('ocean_model', 'h_PFu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Pressure Force Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Pressure Force Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_PFv = register_diag_field('ocean_model', 'h_PFv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Pressure Force Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Pressure Force Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_PFu_2d = register_diag_field('ocean_model', 'intz_PFu_2d', diag%axesCu1, Time, & @@ -1613,13 +1397,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_CAv_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_CAu = register_diag_field('ocean_model', 'h_CAu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_CAv = register_diag_field('ocean_model', 'h_CAv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_CAu_2d = register_diag_field('ocean_model', 'intz_CAu_2d', diag%axesCu1, Time, & @@ -1663,13 +1447,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_u_BT_accel = register_diag_field('ocean_model', 'h_u_BT_accel', diag%axesCuL, Time, & - 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_v_BT_accel = register_diag_field('ocean_model', 'h_v_BT_accel', diag%axesCvL, Time, & - 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_u_BT_accel_2d = register_diag_field('ocean_model', 'intz_u_BT_accel_2d', diag%axesCu1, Time, & @@ -1683,30 +1467,30 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_intz_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_PFu_visc_rem = register_diag_field('ocean_model', 'PFu_visc_rem', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_PFu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_CAu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_u_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 439ed242b8..9979ecb5b1 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -9,6 +9,8 @@ module MOM_diagnostics use MOM_coupler_types, only : coupler_type_send_data use MOM_density_integrals, only : int_density_dz use MOM_diag_mediator, only : post_data, get_diag_time_end +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, register_scalar_field use MOM_diag_mediator, only : register_static_field, diag_register_area_ids use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr @@ -226,8 +228,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !! previous call to diagnostics_init. ! Local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: usq ! squared eastward velocity [L2 T-2 ~> m2 s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vsq ! squared northward velocity [L2 T-2 ~> m2 s-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: uv ! u x v at h-points [L2 T-2 ~> m2 s-2] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -238,12 +238,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] - real, allocatable, dimension(:,:) :: & - hf_du_dt_2d, hf_dv_dt_2d ! z integeral of hf_du_dt, hf_dv_dt [L T-2 ~> m s-2]. - - real, allocatable, dimension(:,:,:) :: h_du_dt ! h x dudt [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt ! h x dvdt [H L T-2 ~> m2 s-2] - ! tmp array for surface properties real :: surface_field(SZI_(G),SZJ_(G)) real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS [R L2 T-2 ~> Pa] @@ -278,70 +272,32 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) if (CS%id_h_pre_sync > 0) & - call post_data(CS%id_h_pre_sync, diag_pre_sync%h_state, CS%diag, alt_h = diag_pre_sync%h_state) + call post_data(CS%id_h_pre_sync, diag_pre_sync%h_state, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_du_dt>0) call post_data(CS%id_du_dt, CS%du_dt, CS%diag, alt_h = diag_pre_sync%h_state) + if (CS%id_du_dt>0) call post_data(CS%id_du_dt, CS%du_dt, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_dv_dt>0) call post_data(CS%id_dv_dt, CS%dv_dt, CS%diag, alt_h = diag_pre_sync%h_state) + if (CS%id_dv_dt>0) call post_data(CS%id_dv_dt, CS%dv_dt, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_dh_dt>0) call post_data(CS%id_dh_dt, CS%dh_dt, CS%diag, alt_h = diag_pre_sync%h_state) + if (CS%id_dh_dt>0) call post_data(CS%id_dh_dt, CS%dh_dt, CS%diag, alt_h=diag_pre_sync%h_state) !! Diagnostics for terms multiplied by fractional thicknesses ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. + ! The code is retained for debugging purposes in the future. !if (CS%id_hf_du_dt > 0) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_du_dt(I,j,k) = CS%du_dt(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_du_dt, CS%hf_du_dt, CS%diag, alt_h = diag_pre_sync%h_state) - !endif - - !if (CS%id_hf_dv_dt > 0) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_dv_dt(i,J,k) = CS%dv_dt(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_dv_dt, CS%hf_dv_dt, CS%diag, alt_h = diag_pre_sync%h_state) - !endif - - if (CS%id_hf_du_dt_2d > 0) then - allocate(hf_du_dt_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_du_dt_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_du_dt_2d(I,j) = hf_du_dt_2d(I,j) + CS%du_dt(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_du_dt_2d, hf_du_dt_2d, CS%diag) - deallocate(hf_du_dt_2d) - endif + ! call post_product_u(CS%id_hf_du_dt, CS%du_dt, ADp%diag_hfrac_u, G, nz, CS%diag, alt_h=diag_pre_sync%h_state) + !if (CS%id_hf_dv_dt > 0) & + ! call post_product_v(CS%id_hf_dv_dt, CS%dv_dt, ADp%diag_hfrac_v, G, nz, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_hf_dv_dt_2d > 0) then - allocate(hf_dv_dt_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_dv_dt_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dv_dt_2d(i,J) = hf_dv_dt_2d(i,J) + CS%dv_dt(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dv_dt_2d, hf_dv_dt_2d, CS%diag) - deallocate(hf_dv_dt_2d) - endif + if (CS%id_hf_du_dt_2d > 0) & + call post_product_sum_u(CS%id_hf_du_dt_2d, CS%du_dt, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dv_dt_2d > 0) & + call post_product_sum_v(CS%id_hf_dv_dt_2d, CS%dv_dt, ADp%diag_hfrac_v, G, nz, CS%diag) - if (CS%id_h_du_dt > 0) then - allocate(h_du_dt(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_du_dt(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt(I,j,k) = CS%du_dt(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt, h_du_dt, CS%diag) - deallocate(h_du_dt) - endif - if (CS%id_h_dv_dt > 0) then - allocate(h_dv_dt(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_dv_dt(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt(i,J,k) = CS%dv_dt(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt, h_dv_dt, CS%diag) - deallocate(h_dv_dt) - endif + if (CS%id_h_du_dt > 0) & + call post_product_u(CS%id_h_du_dt, CS%du_dt, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt > 0) & + call post_product_v(CS%id_h_dv_dt, CS%dv_dt, ADp%diag_hv, G, nz, CS%diag) call diag_restore_grids(CS%diag) @@ -362,24 +318,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) - if (CS%id_usq > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - usq(I,j,k) = u(I,j,k) * u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_usq, usq, CS%diag) - endif + if (CS%id_usq > 0) call post_product_u(CS%id_usq, u, u, G, nz, CS%diag) - if (CS%id_vsq > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vsq(i,J,k) = v(i,J,k) * v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_vsq, vsq, CS%diag) - endif + if (CS%id_vsq > 0) call post_product_v(CS%id_vsq, v, v, G, nz, CS%diag) if (CS%id_uv > 0) then do k=1,nz ; do j=js,je ; do i=is,ie uv(i,j,k) = (0.5*(u(I-1,j,k) + u(I,j,k))) * & - (0.5*(v(i,J-1,k) + v(i,J,k))) + (0.5*(v(i,J-1,k) + v(i,J,k))) enddo ; enddo ; enddo call post_data(CS%id_uv, uv, CS%diag) endif diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4381af9d84..6a9b49683c 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -6,6 +6,8 @@ module MOM_hor_visc use MOM_checksums, only : hchksum, Bchksum use MOM_coms, only : min_across_PEs use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, CORNER, pass_vector, AGRID, BGRID_NE use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe @@ -1662,90 +1664,30 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call post_data(CS%id_FrictWorkIntz, FrictWorkIntz, CS%diag) endif - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (present(ADp) .and. (CS%id_hf_diffu > 0)) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_diffu, CS%hf_diffu, CS%diag) - !endif - !if (present(ADp) .and. (CS%id_hf_diffv > 0)) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_diffv, CS%hf_diffv, CS%diag) - !endif - if (present(ADp)) then - if (CS%id_hf_diffu_2d > 0) then - hf_diffu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_diffu_2d(I,j) = hf_diffu_2d(I,j) + diffu(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_diffu_2d, hf_diffu_2d, CS%diag) - endif - - if (CS%id_hf_diffv_2d > 0) then - hf_diffv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_diffv_2d(i,J) = hf_diffv_2d(i,J) + diffv(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_diffv_2d, hf_diffv_2d, CS%diag) - endif - - if (CS%id_intz_diffu_2d > 0) then - intz_diffu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_diffu_2d(I,j) = intz_diffu_2d(I,j) + diffu(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_diffu_2d, intz_diffu_2d, CS%diag) - endif - - if (CS%id_intz_diffv_2d > 0) then - intz_diffv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_diffv_2d(i,J) = intz_diffv_2d(i,J) + diffv(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_diffv_2d, intz_diffv_2d, CS%diag) - endif + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics of hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_diffu > 0) call post_product_u(CS%id_hf_diffu, diffu, ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_diffv > 0) call post_product_v(CS%id_hf_diffv, diffv, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged momentum budget terms + if (CS%id_hf_diffu_2d > 0) call post_product_sum_u(CS%id_hf_diffu_2d, diffu, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_diffv_2d > 0) call post_product_sum_v(CS%id_hf_diffv_2d, diffv, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for the vertical sum of layer thickness x momentum budget terms + if (CS%id_intz_diffu_2d > 0) call post_product_sum_u(CS%id_intz_diffu_2d, diffu, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_diffv_2d > 0) call post_product_sum_v(CS%id_intz_diffv_2d, diffv, ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for thickness x momentum budget terms + if (CS%id_h_diffu > 0) call post_product_u(CS%id_h_diffu, diffu, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_diffv > 0) call post_product_v(CS%id_h_diffv, diffv, ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + if (CS%id_diffu_visc_rem > 0) call post_product_u(CS%id_diffu_visc_rem, diffu, ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_diffv_visc_rem > 0) call post_product_v(CS%id_diffv_visc_rem, diffv, ADp%visc_rem_v, G, nz, CS%diag) endif - if (present(ADp) .and. (CS%id_h_diffu > 0)) then - allocate(h_diffu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_diffu, h_diffu, CS%diag) - deallocate(h_diffu) - endif - if (present(ADp) .and. (CS%id_h_diffv > 0)) then - allocate(h_diffv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_diffv, h_diffv, CS%diag) - deallocate(h_diffv) - endif - - if (present(ADp) .and. (CS%id_diffu_visc_rem > 0)) then - allocate(diffu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - diffu_visc_rem(I,j,k) = diffu(I,j,k) * ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_diffu_visc_rem, diffu_visc_rem, CS%diag) - deallocate(diffu_visc_rem) - endif - if (present(ADp) .and. (CS%id_diffv_visc_rem > 0)) then - allocate(diffv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - diffv_visc_rem(i,J,k) = diffv(i,J,k) * ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_diffv_visc_rem, diffv_visc_rem, CS%diag) - deallocate(diffv_visc_rem) - endif end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). @@ -2467,15 +2409,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) endif CS%id_h_diffu = register_diag_field('ocean_model', 'h_diffu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if ((CS%id_h_diffu > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%diag_hu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) endif CS%id_h_diffv = register_diag_field('ocean_model', 'h_diffv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if ((CS%id_h_diffv > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%diag_hv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif @@ -2495,15 +2437,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) endif CS%id_diffu_visc_rem = register_diag_field('ocean_model', 'diffu_visc_rem', diag%axesCuL, Time, & - 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_diffu_visc_rem > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%visc_rem_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) endif CS%id_diffv_visc_rem = register_diag_field('ocean_model', 'diffv_visc_rem', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_diffv_visc_rem > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%visc_rem_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c0ea3aff53..77ec87b230 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -15,6 +15,7 @@ module MOM_diabatic_driver use MOM_diabatic_aux, only : triDiagTS_Eulerian, find_uv_at_h, diagnoseMLDbyDensityDifference use MOM_diabatic_aux, only : applyBoundaryFluxesInOut, diagnoseMLDbyEnergy, set_pen_shortwave use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_sum_u, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end @@ -2499,24 +2500,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - !! Diagnostics for terms multiplied by fractional thicknesses - if (CS%id_hf_dudt_dia_2d > 0) then - allocate(hf_dudt_dia_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_dudt_dia_2d(I,j) = hf_dudt_dia_2d(I,j) + ADp%du_dt_dia(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dudt_dia_2d, hf_dudt_dia_2d, CS%diag) - deallocate(hf_dudt_dia_2d) - endif - - if (CS%id_hf_dvdt_dia_2d > 0) then - allocate(hf_dvdt_dia_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dvdt_dia_2d(i,J) = hf_dvdt_dia_2d(i,J) + ADp%dv_dt_dia(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dvdt_dia_2d, hf_dvdt_dia_2d, CS%diag) - deallocate(hf_dvdt_dia_2d) - endif + ! Diagnostics for thickness-weighted vertically averaged diapycnal accelerations + if (CS%id_hf_dudt_dia_2d > 0) & + call post_product_sum_u(CS%id_hf_dudt_dia_2d, ADp%du_dt_dia, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dvdt_dia_2d > 0) & + call post_product_sum_v(CS%id_hf_dvdt_dia_2d, ADp%dv_dt_dia, ADp%diag_hfrac_v, G, nz, CS%diag) call disable_averaging(CS%diag) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index b332346c6c..adac9e83f4 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -4,23 +4,25 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. use MOM_domains, only : pass_var, To_All, Omit_corners use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl -use MOM_debugging, only : uvchksum, hchksum +use MOM_debugging, only : uvchksum, hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : mech_forcing -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : mech_forcing +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S -use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init -use MOM_PointAccel, only : PointAccel_CS -use MOM_time_manager, only : time_type, time_type_to_real, operator(-) -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type -use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs -use MOM_variables, only : ocean_internal_state -use MOM_verticalGrid, only : verticalGrid_type +use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init +use MOM_PointAccel, only : PointAccel_CS +use MOM_time_manager, only : time_type, time_type_to_real, operator(-) +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type +use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs +use MOM_variables, only : ocean_internal_state +use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS implicit none ; private @@ -136,11 +138,6 @@ module MOM_vert_friction type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure !! for recording accelerations leading to velocity truncations - ! real, pointer :: hf_du_dt_visc(:,:,:) => NULL() ! Zonal friction accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, pointer :: hf_dv_dt_visc(:,:,:) => NULL() ! Merdional friction accel. x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - end type vertvisc_CS contains @@ -217,16 +214,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. - real, allocatable, dimension(:,:) :: hf_du_dt_visc_2d ! Depth sum of hf_du_dt_visc [L T-2 ~> m s-2] - real, allocatable, dimension(:,:) :: hf_dv_dt_visc_2d ! Depth sum of hf_dv_dt_visc [L T-2 ~> m s-2] - - real, allocatable, dimension(:,:,:) :: h_du_dt_visc ! h x du_dt_visc [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt_visc ! h x dv_dt_visc [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_du_dt_str ! h x du_dt_str [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt_str ! h x dv_dt_str [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: du_dt_str_visc_rem ! du_dt_str x visc_rem_u [L T-2 ~> m s-2] - real, allocatable, dimension(:,:,:) :: dv_dt_str_visc_rem ! dv_dt_str x visc_rem_v [L T-2 ~> m s-2] - logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -525,92 +512,36 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (CS%id_dv_dt_str > 0) & call post_data(CS%id_dv_dt_str, ADp%dv_dt_str, CS%diag) - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (CS%id_hf_du_dt_visc > 0) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_du_dt_visc, CS%hf_du_dt_visc, CS%diag) - !endif - !if (CS%id_hf_dv_dt_visc > 0) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_dv_dt_visc, CS%hf_dv_dt_visc, CS%diag) - !endif - if (CS%id_hf_du_dt_visc_2d > 0) then - allocate(hf_du_dt_visc_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_du_dt_visc_2d(I,j) = hf_du_dt_visc_2d(I,j) + ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_du_dt_visc_2d, hf_du_dt_visc_2d, CS%diag) - deallocate(hf_du_dt_visc_2d) - endif - if (CS%id_hf_dv_dt_visc_2d > 0) then - allocate(hf_dv_dt_visc_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dv_dt_visc_2d(i,J) = hf_dv_dt_visc_2d(i,J) + ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dv_dt_visc_2d, hf_dv_dt_visc_2d, CS%diag) - deallocate(hf_dv_dt_visc_2d) + if (associated(ADp%du_dt_visc) .and. associated(ADp%du_dt_visc)) then + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics of hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_du_dt_visc > 0) & + ! call post_product_u(CS%id_hf_du_dt_visc, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_dv_dt_visc > 0) & + ! call post_product_v(CS%id_hf_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged viscous accelerations + if (CS%id_hf_du_dt_visc_2d > 0) & + call post_product_sum_u(CS%id_hf_du_dt_visc_2d, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dv_dt_visc_2d > 0) & + call post_product_sum_v(CS%id_hf_dv_dt_visc_2d, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness x viscous accelerations + if (CS%id_h_du_dt_visc > 0) call post_product_u(CS%id_h_du_dt_visc, ADp%du_dt_visc, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_visc > 0) call post_product_v(CS%id_h_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hv, G, nz, CS%diag) endif - if (CS%id_h_du_dt_visc > 0) then - allocate(h_du_dt_visc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt_visc, h_du_dt_visc, CS%diag) - deallocate(h_du_dt_visc) - endif - if (CS%id_h_dv_dt_visc > 0) then - allocate(h_dv_dt_visc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt_visc, h_dv_dt_visc, CS%diag) - deallocate(h_dv_dt_visc) - endif - - if (CS%id_h_du_dt_str > 0) then - allocate(h_du_dt_str(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_du_dt_str(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt_str(I,j,k) = ADp%du_dt_str(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt_str, h_du_dt_str, CS%diag) - deallocate(h_du_dt_str) - endif - if (CS%id_h_dv_dt_str > 0) then - allocate(h_dv_dt_str(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_dv_dt_str(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt_str(i,J,k) = ADp%dv_dt_str(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt_str, h_dv_dt_str, CS%diag) - deallocate(h_dv_dt_str) - endif + if (associated(ADp%du_dt_str) .and. associated(ADp%dv_dt_str)) then + ! Diagnostics for thickness x wind stress acclerations + if (CS%id_h_du_dt_str > 0) call post_product_u(CS%id_h_du_dt_str, ADp%du_dt_str, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_str > 0) call post_product_v(CS%id_h_dv_dt_str, ADp%dv_dt_str, ADp%diag_hv, G, nz, CS%diag) - if (CS%id_du_dt_str_visc_rem > 0) then - allocate(du_dt_str_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - du_dt_str_visc_rem(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - du_dt_str_visc_rem(I,j,k) = ADp%du_dt_str(I,j,k) * ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_du_dt_str_visc_rem, du_dt_str_visc_rem, CS%diag) - deallocate(du_dt_str_visc_rem) - endif - if (CS%id_dv_dt_str_visc_rem > 0) then - allocate(dv_dt_str_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - dv_dt_str_visc_rem(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - dv_dt_str_visc_rem(i,J,k) = ADp%dv_dt_str(i,J,k) * ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_dv_dt_str_visc_rem, dv_dt_str_visc_rem, CS%diag) - deallocate(dv_dt_str_visc_rem) + ! Diagnostics for wind stress accelerations multiplied by visc_rem_[uv], + if (CS%id_du_dt_str_visc_rem > 0) & + call post_product_u(CS%id_du_dt_str_visc_rem, ADp%du_dt_str, ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_dv_dt_str_visc_rem > 0) & + call post_product_v(CS%id_dv_dt_str_visc_rem, ADp%dv_dt_str, ADp%visc_rem_v, G, nz, CS%diag) endif end subroutine vertvisc @@ -1922,7 +1853,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! 'Fractional Thickness-weighted Zonal Acceleration from Vertical Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if (CS%id_hf_du_dt_visc > 0) then - ! call safe_alloc_ptr(CS%hf_du_dt_visc,IsdB,IedB,jsd,jed,nz) ! call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) !endif @@ -1931,7 +1861,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! 'Fractional Thickness-weighted Meridional Acceleration from Vertical Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if (CS%id_hf_dv_dt_visc > 0) then - ! call safe_alloc_ptr(CS%hf_dv_dt_visc,isd,ied,JsdB,JedB,nz) ! call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) !endif @@ -1953,48 +1882,48 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & endif CS%id_h_du_dt_visc = register_diag_field('ocean_model', 'h_du_dt_visc', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_du_dt_visc > 0) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) endif CS%id_h_dv_dt_visc = register_diag_field('ocean_model', 'h_dv_dt_visc', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_dv_dt_visc > 0) then call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) endif CS%id_h_du_dt_str = register_diag_field('ocean_model', 'h_du_dt_str', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Surface Wind Stresses', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Surface Wind Stresses', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_du_dt_str > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) endif CS%id_h_dv_dt_str = register_diag_field('ocean_model', 'h_dv_dt_str', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Surface Wind Stresses', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Surface Wind Stresses', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_dv_dt_str > 0) then call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) endif CS%id_du_dt_str_visc_rem = register_diag_field('ocean_model', 'du_dt_str_visc_rem', diag%axesCuL, Time, & - 'Zonal Acceleration from Surface Wind Stresses multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Acceleration from Surface Wind Stresses multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_str_visc_rem > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) endif CS%id_dv_dt_str_visc_rem = register_diag_field('ocean_model', 'dv_dt_str_visc_rem', diag%axesCvL, Time, & - 'Meridional Acceleration from Surface Wind Stresses multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Acceleration from Surface Wind Stresses multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_str_visc_rem > 0) then call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) From 5f21667f09d46612825c33a078e7083488952270 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Dec 2021 10:59:59 -0500 Subject: [PATCH 093/138] +Rescale fluxes%net_mass_src and other diagnostics (#23) Retaing dimensional rescaling for several diagnostics: - Apply dimensional rescaling of fluxes%net_mass_src to and the net_mass_src argument to get_net_mass_forcing to [R Z T-1]. - Rescaled the patm argument of convert_state_to_ocean_type to [R L2 T-2] and press_to_Z to [Z T2 R-1 L-2]; these are not actually exercised yet, so this has a very limited scope, although three other local variables were also dimensionally rescaled. - Revised the line breaks in two calls to register_restart to place the units and conversion factos on the same line, following a widespread code pattern. - Used the scale argument in calls to global_area_integral or global_area_mean for 6 diagnostics, so that 3 other primary variables can be calculated in scaled units and rescaled via factors specified in the register_restart calls, following a widespread code pattern. All answers and output are bitwise identical. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 20 ++-- .../drivers/FMS_cap/ocean_model_MOM.F90 | 37 +++--- src/core/MOM_forcing_type.F90 | 113 ++++++++---------- 3 files changed, 82 insertions(+), 88 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 5e156abb54..84beb3fcf4 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -243,8 +243,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, real :: delta_sss ! temporary storage for sss diff from restoring value [ppt] real :: delta_sst ! temporary storage for sst diff from restoring value [degC] - real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling - ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. + real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling + ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1] real :: rhoXcp ! Reference density times heat capacity times unit scaling ! factors [Q R degC-1 ~> J m-3 degC-1] real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. @@ -658,7 +658,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points [L4 Z-1 T-1 ~> m3 s-1] - net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. + net_mass_src, & ! A temporary of net mass sources [R Z T-1 ~> kg m-2 s-1]. ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. real :: I_GEarth ! The inverse of the gravitational acceleration [T2 Z L-2 ~> s2 m-1] @@ -666,6 +666,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real :: mass_ice ! mass of sea ice at a face [R Z ~> kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [R Z ~> kg m-2] real :: wt1, wt2 ! Relative weights of previous and current values of ustar [nondim]. + real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling + ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer @@ -682,6 +684,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd + kg_m2_s_conversion = US%kg_m2s_to_RZ_T + ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. if (.not.forces%initialized) then @@ -774,15 +778,15 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then if (associated(IOB%lprec)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%lprec(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%lprec(i-i0,j-j0) if (associated(IOB%fprec)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%fprec(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%fprec(i-i0,j-j0) if (associated(IOB%runoff)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%runoff(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%runoff(i-i0,j-j0) if (associated(IOB%calving)) & - net_mass_src(i,j) = net_mass_src(i,j) + IOB%calving(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%calving(i-i0,j-j0) if (associated(IOB%q_flux)) & - net_mass_src(i,j) = net_mass_src(i,j) - IOB%q_flux(i-i0,j-j0) + net_mass_src(i,j) = net_mass_src(i,j) - kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) endif ; enddo ; enddo if (wt1 <= 0.0) then do j=js,je ; do i=is,ie diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 93cf891bfe..97fb869ad4 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -154,8 +154,8 @@ module ocean_model_mod logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the !! ocean dynamics and forcing fluxes. - real :: press_to_z !< A conversion factor between pressure and ocean - !! depth in m, usually 1/(rho_0*g) [m Pa-1]. + real :: press_to_z !< A conversion factor between pressure and ocean depth, + !! usually 1/(rho_0*g) [Z T2 R-1 L-2 ~> m Pa-1]. real :: C_p !< The heat capacity of seawater [J degC-1 kg-1]. logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode !! with the barotropic and baroclinic dynamics, thermodynamics, @@ -242,16 +242,16 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. ! Local variables - real :: Rho0 ! The Boussinesq ocean density [kg m-3]. - real :: G_Earth ! The gravitational acceleration [m s-2]. - real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. + real :: Rho0 ! The Boussinesq ocean density [R ~> kg m-3] + real :: G_Earth ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] + real :: HFrz !< If HFrz > 0 [Z ~> m], melt potential will be computed. !! The actual depth over which melt potential is computed will !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. - logical :: use_melt_pot!< If true, allocate melt_potential array + logical :: use_melt_pot !< If true, allocate melt_potential array -! 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 = "ocean_model_init" ! This module's name. character(len=48) :: stagger ! A string indicating the staggering locations for the ! surface velocities returned to the coupler. @@ -331,10 +331,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas "calculate accelerations and the mass for conservation "//& "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=OS%US%kg_m3_to_R) call get_param(param_file, mdl, "G_EARTH", G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default=9.80, scale=OS%US%m_s_to_L_T**2*OS%US%Z_to_m) call get_param(param_file, mdl, "ICE_SHELF", OS%use_ice_shelf, & "If true, enables the ice shelf model.", default=.false.) @@ -342,7 +342,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, & "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) - OS%press_to_z = 1.0/(Rho0*G_Earth) + OS%press_to_z = 1.0 / (Rho0*G_Earth) ! Consider using a run-time flag to determine whether to do the diagnostic ! vertical integrals, since the related 3-d sums are not negligible in cost. @@ -350,9 +350,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas "If HFREEZE > 0, melt potential will be computed. The actual depth "//& "over which melt potential is computed will be min(HFREEZE, OBLD), "//& "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//& - "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + "melt potential will not be computed.", & + units="m", default=-1.0, scale=OS%US%m_to_Z, do_not_log=.true.) - if (HFrz .gt. 0.0) then + if (HFrz > 0.0) then use_melt_pot=.true. else use_melt_pot=.false. @@ -655,7 +656,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US, & -! Ice_ocean_boundary%p, OS%press_to_z) +! OS%fluxes%p_surf_full, OS%press_to_z) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn call coupler_type_send_data(Ocean_sfc%fields, Time1) @@ -816,9 +817,9 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface [Pa]. - real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and - !! ocean depth in m, usually 1/(rho_0*g) [m Pa-1]. + real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface [R L2 T-2 ~> Pa] + real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and ocean + !! depth, usually 1/(rho_0*g) [Z T2 R-1 L-2 ~> m Pa-1] ! Local variables real :: IgR0 character(len=48) :: val_str @@ -860,7 +861,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%sea_lev(i,j) = US%Z_to_m * sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z + Ocean_sfc%sea_lev(i,j) = US%Z_to_m * (sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z) Ocean_sfc%area(i,j) = US%L_to_m**2 * G%areaT(i+i0,j+j0) enddo ; enddo else diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 59c65945ef..c58340c498 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -219,7 +219,7 @@ module MOM_forcing_type taux => NULL(), & !< zonal wind stress [R L Z T-2 ~> Pa] tauy => NULL(), & !< meridional wind stress [R L Z T-2 ~> Pa] ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. - net_mass_src => NULL() !< The net mass source to the ocean [kg m-2 s-1]. + net_mass_src => NULL() !< The net mass source to the ocean [R Z T-1 ~> kg m-2 s-1] ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() @@ -585,7 +585,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & ! for non-Bouss, we add/remove salt mass to total ocean mass. to conserve ! total salt mass ocean+ice, the sea ice model must lose mass when salt mass ! is added to the ocean, which may still need to be coded. Not that the units - ! of netMassInOut are still kg_m2, so no conversion to H should occur yet. + ! of netMassInOut are still [Z R ~> kg m-2], so no conversion to H should occur yet. if (.not.GV%Boussinesq .and. associated(fluxes%salt_flux)) then netMassInOut(i) = netMassInOut(i) + dt * (scale * fluxes%salt_flux(i,j)) if (do_NMIOr) netMassInOut_rate(i) = netMassInOut_rate(i) + & @@ -1272,7 +1272,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, Time, & 'Meridional surface stress ocean interactions with atmos and ice', & - 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & + 'Pa', conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s, & standard_name='surface_downward_y_stress', cmor_field_name='tauvo', & cmor_units='N m-2', cmor_long_name='Surface Downward Y Stress', & cmor_standard_name='surface_downward_y_stress') @@ -1347,11 +1347,11 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, !=============================================================== ! surface mass flux maps - handles%id_prcme = register_diag_field('ocean_model', 'PRCmE', diag%axesT1, Time, & - 'Net surface water flux (precip+melt+lrunoff+ice calving-evap)', 'kg m-2 s-1', & - standard_name='water_flux_into_sea_water', cmor_field_name='wfo', & + handles%id_prcme = register_diag_field('ocean_model', 'PRCmE', diag%axesT1, Time, & + 'Net surface water flux (precip+melt+lrunoff+ice calving-evap)', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & + standard_name='water_flux_into_sea_water', cmor_field_name='wfo', & cmor_standard_name='water_flux_into_sea_water',cmor_long_name='Water Flux Into Sea Water') - ! 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)', & @@ -1370,8 +1370,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 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') - ! This diagnostic is rescaled to MKS units when combined. + 'Liquid + frozen precipitation into ocean', 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) handles%id_fprec = register_diag_field('ocean_model', 'fprec', diag%axesT1, Time, & 'Frozen precipitation into ocean', & @@ -1406,12 +1405,12 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, cmor_long_name='Water Flux into Sea Water From Rivers') handles%id_net_massout = register_diag_field('ocean_model', 'net_massout', diag%axesT1, Time, & - 'Net mass leaving the ocean due to evaporation, seaice formation', 'kg m-2 s-1') - ! This diagnostic is rescaled to MKS units when combined. + 'Net mass leaving the ocean due to evaporation, seaice formation', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) handles%id_net_massin = register_diag_field('ocean_model', 'net_massin', diag%axesT1, Time, & - 'Net mass entering ocean due to precip, runoff, ice melt', 'kg m-2 s-1') - ! This diagnostic is rescaled to MKS units when combined. + 'Net mass entering ocean due to precip, runoff, ice melt', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) handles%id_massout_flux = register_diag_field('ocean_model', 'massout_flux', diag%axesT1, Time, & 'Net mass flux of freshwater out of the ocean (used in the boundary flux calculation)', & @@ -2216,35 +2215,32 @@ subroutine get_net_mass_forcing(fluxes, G, US, net_mass_src) type(ocean_grid_type), intent(in) :: G !< The ocean grid type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean - !! [kg m-2 s-1]. + !! [R Z T-1 ~> kg m-2 s-1]. - real :: RZ_T_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - RZ_T_conversion = US%RZ_T_to_kg_m2s - net_mass_src(:,:) = 0.0 if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%lprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lprec(i,j) enddo ; enddo ; endif if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%fprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%fprec(i,j) enddo ; enddo ; endif if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%vprec(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%vprec(i,j) enddo ; enddo ; endif if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%lrunoff(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lrunoff(i,j) enddo ; enddo ; endif if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%frunoff(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%frunoff(i,j) enddo ; enddo ; endif if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%evap(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j) enddo ; enddo ; endif if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%seaice_melt(i,j) enddo ; enddo ; endif end subroutine get_net_mass_forcing @@ -2339,11 +2335,10 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h ! local variables type(ocean_grid_type), pointer :: G ! Grid metric on model index map type(forcing), pointer :: fluxes ! Fluxes on the model index map - real, dimension(SZI_(diag%G),SZJ_(diag%G)) :: res ! A temporary array for rescaled combinations - ! of fluxes in MKS units, like [kg m-2 s-1] or [W m-2] - real :: total_transport ! for diagnosing integrated boundary transport, in MKS units like [kg s-1] or [W] - real :: ave_flux ! for diagnosing averaged boundary flux, in MKS units like [kg m-2 s-1] or [W m-2] - real :: RZ_T_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1] + real, dimension(SZI_(diag%G),SZJ_(diag%G)) :: res ! A temporary array for combinations + ! of fluxes [R Z T-1 ~> kg m-2 s-1] or [Q R Z T-1 ~> W m-2] + real :: total_transport ! for diagnosing integrated boundary transport, in MKS units of [kg s-1] or [W] + real :: ave_flux ! for diagnosing averaged boundary flux, in MKS units of [kg m-2 s-1] or [W m-2] real :: I_dt ! inverse time step [T-1 ~> s-1] real :: ppt2mks ! conversion between ppt and mks units [nondim] integer :: turns ! Number of index quarter turns @@ -2364,7 +2359,6 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h fluxes => fluxes_in endif - RZ_T_conversion = US%RZ_T_to_kg_m2s I_dt = 1.0 / fluxes%dt_buoy_accum ppt2mks = 1e-3 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2377,22 +2371,22 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if (handles%id_prcme > 0 .or. handles%id_total_prcme > 0 .or. handles%id_prcme_ga > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%lprec)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lprec(i,j) - if (associated(fluxes%fprec)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%fprec(i,j) + if (associated(fluxes%lprec)) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (associated(fluxes%fprec)) res(i,j) = res(i,j) + fluxes%fprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 - if (associated(fluxes%evap)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%evap(i,j) - if (associated(fluxes%lrunoff)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lrunoff(i,j) - if (associated(fluxes%frunoff)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%frunoff(i,j) - if (associated(fluxes%vprec)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) - if (associated(fluxes%seaice_melt)) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) + if (associated(fluxes%evap)) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (associated(fluxes%lrunoff)) res(i,j) = res(i,j) + fluxes%lrunoff(i,j) + if (associated(fluxes%frunoff)) res(i,j) = res(i,j) + fluxes%frunoff(i,j) + if (associated(fluxes%vprec)) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (associated(fluxes%seaice_melt)) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) enddo ; enddo if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag) if (handles%id_total_prcme > 0) then - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_prcme, total_transport, diag) endif if (handles%id_prcme_ga > 0) then - ave_flux = global_area_mean(res, G) + ave_flux = global_area_mean(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_prcme_ga, ave_flux, diag) endif endif @@ -2401,64 +2395,59 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%lprec)) then - if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lprec(i,j) + if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) endif if (associated(fluxes%vprec)) then - if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) + if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) endif if (associated(fluxes%evap)) then - if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%evap(i,j) + if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) endif if (associated(fluxes%seaice_melt)) then - if (fluxes%seaice_melt(i,j) < 0.0) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) + if (fluxes%seaice_melt(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) endif enddo ; enddo if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag) if (handles%id_total_net_massout > 0) then - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_net_massout, total_transport, diag) endif endif if (handles%id_massout_flux > 0 .and. associated(fluxes%netMassOut)) & - call post_data(handles%id_massout_flux,fluxes%netMassOut,diag) + call post_data(handles%id_massout_flux, fluxes%netMassOut, diag) if (handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%fprec)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%fprec(i,j) - if (associated(fluxes%lrunoff)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lrunoff(i,j) - if (associated(fluxes%frunoff)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%frunoff(i,j) + if (associated(fluxes%fprec)) res(i,j) = res(i,j) + fluxes%fprec(i,j) + if (associated(fluxes%lrunoff)) res(i,j) = res(i,j) + fluxes%lrunoff(i,j) + if (associated(fluxes%frunoff)) res(i,j) = res(i,j) + fluxes%frunoff(i,j) if (associated(fluxes%lprec)) then - if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%lprec(i,j) + if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) endif if (associated(fluxes%vprec)) then - if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%vprec(i,j) + if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) endif ! fluxes%cond is not needed because it is derived from %evap > 0 if (associated(fluxes%evap)) then - if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + RZ_T_conversion*fluxes%evap(i,j) + if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) endif if (associated(fluxes%seaice_melt)) then - if (fluxes%seaice_melt(i,j) > 0.0) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%seaice_melt(i,j) + if (fluxes%seaice_melt(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) endif enddo ; enddo if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag) if (handles%id_total_net_massin > 0) then - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_net_massin, total_transport, diag) endif endif if (handles%id_massin_flux > 0 .and. associated(fluxes%netMassIn)) & - call post_data(handles%id_massin_flux,fluxes%netMassIn,diag) + call post_data(handles%id_massin_flux, fluxes%netMassIn, diag) if ((handles%id_evap > 0) .and. associated(fluxes%evap)) & call post_data(handles%id_evap, fluxes%evap, diag) @@ -2473,15 +2462,15 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - res(i,j) = RZ_T_conversion* (fluxes%lprec(i,j) + fluxes%fprec(i,j)) + res(i,j) = fluxes%lprec(i,j) + fluxes%fprec(i,j) enddo ; enddo if (handles%id_precip > 0) call post_data(handles%id_precip, res, diag) if (handles%id_total_precip > 0) then - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_total_precip, total_transport, diag) endif if (handles%id_precip_ga > 0) then - ave_flux = global_area_mean(res, G) + ave_flux = global_area_mean(res, G, scale=US%RZ_T_to_kg_m2s) call post_data(handles%id_precip_ga, ave_flux, diag) endif endif From e2c81e91690b7b9511ee439ebc05164b2c39b72f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Dec 2021 15:13:51 -0500 Subject: [PATCH 094/138] +Rescale forcing arguments and revise ctrl_forcing (#25) * +Rescale forcing arguments and revise ctrl_forcing This commit revisits the units of the input arguments to the various ocean- only surfaces forcing routines, including: - Rescaled the units of the time intervals passed to the various forcing routines to [T ~> s] - Applied dimensional scaling to MOM_controlled_forcing.F90. This code is not yet in active use, so these changes can not change answers, but it is now much closer to compliance with modern MOM6 standards, including improved documentation, and could be ready to try without too much more effort. - Documented the remaining real variables in benchmark_initialization.F90, along with their units. All answers are bitwise identical, but there are changes to the units of some arguments in public interfaces. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 8 +- .../solo_driver/MESO_surface_forcing.F90 | 6 +- .../solo_driver/MOM_surface_forcing.F90 | 20 +- .../solo_driver/user_surface_forcing.F90 | 6 +- src/user/BFB_surface_forcing.F90 | 7 +- src/user/MOM_controlled_forcing.F90 | 347 +++++++++++------- src/user/benchmark_initialization.F90 | 53 +-- src/user/dumbbell_surface_forcing.F90 | 17 +- src/user/user_revise_forcing.F90 | 8 +- 9 files changed, 281 insertions(+), 191 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 84beb3fcf4..d7c483ce49 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -404,7 +404,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & - rhoXcp * delta_sst * CS%Flux_const_temp ! W m-2 + rhoXcp * delta_sst * CS%Flux_const_temp ! [Q R Z T-1 ~> W m-2] enddo ; enddo endif @@ -568,8 +568,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, !#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo -!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, US%s_to_T*valid_time, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged @@ -1601,7 +1601,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) endif endif -!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, US, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) diff --git a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 index f39dff2a0b..300c736802 100644 --- a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 @@ -61,7 +61,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] 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(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by @@ -215,8 +215,8 @@ subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module -! 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 = "MESO_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index bf3d517b3d..7c26c2f194 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -233,7 +233,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call ! Local variables - real :: dt ! length of time over which fluxes applied [s] + real :: dt ! length of time over which fluxes applied [T ~> s] type(time_type) :: day_center ! central time of the fluxes. integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -242,7 +242,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US call callTree_enter("set_forcing, MOM_surface_forcing.F90") day_center = day_start + day_interval/2 - dt = time_type_to_real(day_interval) + dt = US%s_to_T * time_type_to_real(day_interval) if (CS%first_call_set_forcing) then ! Allocate memory for the mechanical and thermodynamic forcing fields. @@ -899,7 +899,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by @@ -1162,7 +1162,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, dt, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif call callTree_leave("buoyancy_forcing_from_files") @@ -1175,7 +1175,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by @@ -1289,7 +1289,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, US%T_to_s*dt, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif call callTree_leave("buoyancy_forcing_from_data_override") @@ -1302,7 +1302,7 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by !! a previous surface_forcing_init call @@ -1345,7 +1345,7 @@ subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] 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(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by @@ -1388,7 +1388,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] 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(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by @@ -1908,7 +1908,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C if (trim(CS%wind_config) == "file") & CS%wind_nlev = num_timelevels(CS%wind_file, CS%stress_x_var, min_dims=3) -!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, US, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90 index 960cddf2ac..0af6b126e1 100644 --- a/config_src/drivers/solo_driver/user_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/user_surface_forcing.F90 @@ -104,7 +104,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] 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(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned @@ -242,8 +242,8 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to !! the control structure for this module -! 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 = "user_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 6b17d64697..6214f2d095 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -52,7 +52,7 @@ subroutine BFB_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] 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(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure @@ -177,8 +177,9 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to !! regulate diagnostic output. type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure for this module -! 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 = "BFB_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 4d44e580e0..f783a271a6 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -8,20 +8,19 @@ module MOM_controlled_forcing ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : post_data, query_averaging_enabled, enable_averages, disable_averaging use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr -use MOM_domains, only : pass_var, pass_vector, AGRID, To_South, To_West, To_All +use MOM_domains, only : pass_var, pass_vector, AGRID, To_South, To_West, To_All use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe -use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_io, only : vardesc, var_desc -use MOM_restart, only : register_restart_field, MOM_restart_CS -use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_date, set_date -use MOM_time_manager, only : time_type_to_real, real_to_time -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) +use MOM_time_manager, only : get_date, set_date +use MOM_time_manager, only : time_type_to_real, real_to_time +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface implicit none ; private @@ -32,89 +31,103 @@ module MOM_controlled_forcing !> Control structure for MOM_controlled_forcing type, public :: ctrl_forcing_CS ; private - logical :: use_temperature !< If true, temperature and salinity are used as - !! state variables. - logical :: do_integrated !< If true, use time-integrated anomalies to control - !! the surface state. - integer :: num_cycle !< The number of elements in the forcing cycle. - real :: heat_int_rate !< The rate at which heating anomalies accumulate [s-1]. - real :: prec_int_rate !< The rate at which precipitation anomalies accumulate [s-1]. - real :: heat_cyc_rate !< The rate at which cyclical heating anomaliess - !! accumulate [s-1]. - real :: prec_cyc_rate !< The rate at which cyclical precipitation anomaliess - !! accumulate [s-1]. + logical :: use_temperature !< If true, temperature and salinity are used as state variables. + logical :: do_integrated !< If true, use time-integrated anomalies to control the surface state. + integer :: num_cycle !< The number of elements in the forcing cycle. + real :: heat_int_rate !< The rate at which heating anomalies accumulate [T-1 ~> s-1] + real :: prec_int_rate !< The rate at which precipitation anomalies accumulate [T-1 ~> s-1] + real :: heat_cyc_rate !< The rate at which cyclical heating anomalies accumulate [T-1 ~> s-1] + real :: prec_cyc_rate !< The rate at which cyclical precipitation anomalies + !! accumulate [T-1 ~> s-1] real :: Len2 !< The square of the length scale over which the anomalies - !! are smoothed via a Laplacian filter [m2]. + !! are smoothed via a Laplacian filter [L2 ~> m2] real :: lam_heat !< A constant of proportionality between SST anomalies - !! and heat fluxes [W m-2 degC-1]. + !! and heat fluxes [Q R Z T-1 degC-1 ~> W m-2 degC-1] real :: lam_prec !< A constant of proportionality between SSS anomalies - !! (normalised by mean SSS) and precipitation [kg m-2]. + !! (normalised by mean SSS) and precipitation [R Z T-1 ~> kg m-2 s-1] real :: lam_cyc_heat !< A constant of proportionality between cyclical SST - !! anomalies and corrective heat fluxes [W m-2 degC-1]. + !! anomalies and corrective heat fluxes [W m-2 degC-1] real :: lam_cyc_prec !< A constant of proportionality between cyclical SSS !! anomalies (normalised by mean SSS) and corrective - !! precipitation [kg m-2]. + !! precipitation [R Z T-1 ~> kg m-2 s-1] - !>@{ Pointers for data. - !! \todo Needs more complete documentation. - real, pointer, dimension(:) :: & - avg_time => NULL() real, pointer, dimension(:,:) :: & - heat_0 => NULL(), & - precip_0 => NULL() + heat_0 => NULL(), & !< The non-periodic integrative corrective heat flux that has been + !! evolved to control mean SST anomalies [Q R Z T-1 ~> W m-2] + precip_0 => NULL() !< The non-periodic integrative corrective precipitation that has been + !! evolved to control mean SSS anomalies [R Z T-1 ~> kg m-2 s-1] + + ! The final dimension of each of the six variables that follow is for the periodic bins. + real, pointer, dimension(:,:,:) :: & + heat_cyc => NULL(), & !< The periodic integrative corrective heat flux that has been evolved + !! to control periodic (seasonal) SST anomalies [Q R Z T-1 ~> W m-2]. + !! The third dimension is the periodic bins. + precip_cyc => NULL() !< The non-periodic integrative corrective precipitation that has been + !! evolved to control periodic (seasonal) SSS anomalies [R Z T-1 ~> kg m-2 s-1]. + !! The third dimension is the periodic bins. + real, pointer, dimension(:) :: & + avg_time => NULL() !< The accumulated averaging time in each part of the cycle [T ~> s] or + !! a negative value to indicate that the variables like avg_SST_anom are + !! the actual averages, and not time integrals. + !! The dimension is the periodic bins. real, pointer, dimension(:,:,:) :: & - heat_cyc => NULL(), & - precip_cyc => NULL(), & - avg_SST_anom => NULL(), & - avg_SSS_anom => NULL(), & - avg_SSS => NULL() - !>@} + avg_SST_anom => NULL(), & !< The time-averaged periodic sea surface temperature anomalies [degC], + !! or (at some points in the code), the time-integrated periodic + !! temperature anomalies [T degC ~> s degC]. + !! The third dimension is the periodic bins. + avg_SSS_anom => NULL(), & !< The time-averaged periodic sea surface salinity anomalies [ppt], + !! or (at some points in the code), the time-integrated periodic + !! salinity anomalies [T ppt ~> s ppt]. + !! The third dimension is the periodic bins. + avg_SSS => NULL() !< The time-averaged periodic sea surface salinities [ppt], or (at + !! some points in the code), the time-integrated periodic + !! salinities [T ppt ~> s ppt]. + !! The third dimension is the periodic bins. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - integer :: id_heat_0 = -1 !< Diagnostic handle + integer :: id_heat_0 = -1 !< Diagnostic handle for the steady heat flux + integer :: id_prec_0 = -1 !< Diagnostic handle for the steady precipitation end type ctrl_forcing_CS contains -!> This subroutine calls any of the other subroutines in this file -!! that are needed to specify the current surface forcing fields. +!> This subroutine determines corrective surface forcing fields using simple control theory. subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_precip, & day_start, dt, G, US, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature - !! anomalies [degC]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_anom !< The sea surface salinity - !! anomlies [ppt]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_mean !< The mean sea surface - !! salinity [ppt]. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature anomalies [degC] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_anom !< The sea surface salinity anomlies [ppt] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_mean !< The mean sea surface salinity [ppt] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: virt_heat !< Virtual (corrective) heat - !! fluxes that are augmented - !! in this subroutine [W m-2]. + !! fluxes that are augmented in this + !! subroutine [Q R Z T-1 ~> W m-2] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: virt_precip !< Virtual (corrective) - !! precipitation fluxes that - !! are augmented in this - !! subroutine [kg m-2 s-1]. - type(time_type), intent(in) :: day_start !< Start time of the fluxes. - real, intent(in) :: dt !< Length of time over which these - !! fluxes will be applied [s]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure - !! returned by a previous call to - !! ctrl_forcing_init. -! + !! precipitation fluxes that are augmented + !! in this subroutine [R Z T-1 ~> kg m-2 s-1] + type(time_type), intent(in) :: day_start !< Start time of the fluxes. + real, intent(in) :: dt !< Length of time over which these fluxes + !! will be applied [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to ctrl_forcing_init. + + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - flux_heat_x, & - flux_prec_x + flux_heat_x, & ! Zonal smoothing flux of the virtual heat fluxes [L2 Q R Z T-1 ~> W] + flux_prec_x ! Zonal smoothing flux of the virtual precipitation [L2 R Z T-1 ~> kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - flux_heat_y, & - flux_prec_y + flux_heat_y, & ! Meridional smoothing flux of the virtual heat fluxes [L2 Q R Z T-1 ~> W] + flux_prec_y ! Meridional smoothing flux of the virtual precipitation [L2 R Z T-1 ~> kg s-1] type(time_type) :: day_end - real :: coef ! A heat-flux coefficient [m2]. - real :: mr_st, mr_end, mr_mid, mr_prev, mr_next - real :: dt_wt, dt_heat_rate, dt_prec_rate - real :: dt1_heat_rate, dt1_prec_rate, dt2_heat_rate, dt2_prec_rate - real :: wt_per1, wt_st, wt_end, wt_mid - integer :: m_st, m_end, m_mid, m_u1, m_u2, m_u3 + real :: coef ! A heat-flux coefficient [L2 ~> m2] + real :: mr_st, mr_end, mr_mid ! Position of various times in the periodic cycle [nondim] + real :: mr_prev, mr_next ! Position of various times in the periodic cycle [nondim] + real :: dt_wt ! The timestep times a fractional weight used to accumulate averages [T ~> s] + real :: dt_heat_rate, dt_prec_rate ! Timestep times the flux accumulation rate [nondim] + real :: dt1_heat_rate, dt1_prec_rate, dt2_heat_rate, dt2_prec_rate ! [nondim] + real :: wt_per1, wt_st, wt_end, wt_mid ! Averaging weights [nondim] + integer :: m_st, m_end, m_mid, m_u1, m_u2, m_u3 ! Indices (nominally months) in the periodic cycle integer :: yr, mon, day, hr, min, sec integer :: i, j, is, ie, js, je @@ -123,7 +136,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if (.not.associated(CS)) return if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return - day_end = day_start + real_to_time(dt) + day_end = day_start + real_to_time(US%T_to_s*dt) do j=js,je ; do i=is,ie virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0 @@ -148,12 +161,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_0(i,j) = CS%heat_0(i,j) + dt_heat_rate * ( & -CS%lam_heat*G%mask2dT(i,j)*SST_anom(i,j) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_0(i,j) = CS%precip_0(i,j) + dt_prec_rate * ( & CS%lam_prec * G%mask2dT(i,j)*(SSS_anom(i,j) / SSS_mean(i,j)) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) virt_heat(i,j) = virt_heat(i,j) + CS%heat_0(i,j) @@ -257,6 +270,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec ! Accumulate the average anomalies for this period. dt_wt = wt_per1 * dt CS%avg_time(m_mid) = CS%avg_time(m_mid) + dt_wt + ! These loops temporarily change the units of the CS%avg_ variables to [degC s] or [ppt s]. do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_mid) = CS%avg_SST_anom(i,j,m_mid) + & dt_wt * G%mask2dT(i,j) * SST_anom(i,j) @@ -281,6 +295,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec m_u2 = periodic_int(m_st - 3.0, CS%num_cycle) m_u3 = periodic_int(m_st - 2.0, CS%num_cycle) + ! These loops restore the units of the CS%avg variables to [degC] or [ppt] if (CS%avg_time(m_u1) > 0.0) then do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_u1) = CS%avg_SST_anom(i,j,m_u1) / CS%avg_time(m_u1) @@ -332,13 +347,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u1) = CS%heat_cyc(i,j,m_u1) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u2) - CS%avg_SST_anom(i,j,m_u1)) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u1) = CS%precip_cyc(i,j,m_u1) + dt1_prec_rate * ( & - CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u2) - CS%avg_SSS_anom(i,j,m_u1)) / & + CS%lam_prec * (CS%avg_SSS_anom(i,j,m_u2) - CS%avg_SSS_anom(i,j,m_u1)) / & (0.5*(CS%avg_SSS(i,j,m_u2) + CS%avg_SSS(i,j,m_u1))) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif @@ -357,19 +372,26 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u2) = CS%heat_cyc(i,j,m_u2) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u3) - CS%avg_SST_anom(i,j,m_u2)) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u2) = CS%precip_cyc(i,j,m_u2) + dt1_prec_rate * ( & - CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u3) - CS%avg_SSS_anom(i,j,m_u2)) / & + CS%lam_prec * (CS%avg_SSS_anom(i,j,m_u3) - CS%avg_SSS_anom(i,j,m_u2)) / & (0.5*(CS%avg_SSS(i,j,m_u3) + CS%avg_SSS(i,j,m_u2))) + & - (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif endif ! (CS%num_cycle > 0) + if (CS%do_integrated .and. ((CS%id_heat_0 > 0) .or. (CS%id_prec_0 > 0))) then + call enable_averages(dt, day_start + real_to_time(US%T_to_s*dt), CS%diag) + if (CS%id_heat_0 > 0) call post_data(CS%id_heat_0, CS%heat_0, CS%diag) + if (CS%id_prec_0 > 0) call post_data(CS%id_prec_0, CS%precip_0, CS%diag) + call disable_averaging(CS%diag) + endif + end subroutine apply_ctrl_forcing !> This function maps rval into an integer in the range from 1 to num_period. @@ -415,7 +437,6 @@ subroutine register_ctrl_forcing_restarts(G, param_file, CS, restart_CS) logical :: controlled, use_temperature character (len=8) :: period_str - type(vardesc) :: vd integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -443,47 +464,44 @@ subroutine register_ctrl_forcing_restarts(G, param_file, CS, restart_CS) call read_param(param_file, "CTRL_FORCE_NUM_CYCLE", CS%num_cycle) if (CS%do_integrated) then - call safe_alloc_ptr(CS%heat_0,isd,ied,jsd,jed) ; CS%heat_0(:,:) = 0.0 - call safe_alloc_ptr(CS%precip_0,isd,ied,jsd,jed) ; CS%precip_0(:,:) = 0.0 - vd = var_desc("Ctrl_heat","W m-2","Control Integrative Heating",z_grid='1') - call register_restart_field(CS%heat_0, vd, .false., restart_CS) - vd = var_desc("Ctrl_precip","kg m-2 s-1","Control Integrative Precipitation",z_grid='1') - call register_restart_field(CS%precip_0, vd, .false., restart_CS) + allocate(CS%heat_0(isd:ied,jsd:jed), source=0.0) + allocate(CS%precip_0(isd:ied,jsd:jed), source=0.0) + + call register_restart_field(CS%heat_0, "Ctrl_heat", .false., restart_CS, & + longname="Control Integrative Heating", units="W m-2", z_grid='1') + call register_restart_field(CS%precip_0, "Ctrl_precip", .false., restart_CS, & + longname="Control Integrative Precipitation", units="kg m-2 s-1", z_grid='1') endif if (CS%num_cycle > 0) then + allocate(CS%heat_cyc(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + allocate(CS%precip_cyc(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + allocate(CS%avg_time(CS%num_cycle), source=0.0) + allocate(CS%avg_SST_anom(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + allocate(CS%avg_SSS_anom(isd:ied,jsd:jed,CS%num_cycle), source=0.0) + write (period_str, '(i8)') CS%num_cycle period_str = trim('p ')//trim(adjustl(period_str)) - call safe_alloc_ptr(CS%heat_cyc,isd,ied,jsd,jed,CS%num_cycle) ; CS%heat_cyc(:,:,:) = 0.0 - call safe_alloc_ptr(CS%precip_cyc,isd,ied,jsd,jed,CS%num_cycle) ; CS%precip_cyc(:,:,:) = 0.0 - vd = var_desc("Ctrl_heat_cycle", "W m-2","Cyclical Control Heating",& - z_grid='1', t_grid=period_str) - call register_restart_field(CS%heat_cyc, vd, .false., restart_CS) - vd = var_desc("Ctrl_precip_cycle","kg m-2 s-1","Cyclical Control Precipitation", & - z_grid='1', t_grid=period_str) - call register_restart_field(CS%precip_cyc, vd, .false., restart_CS) - - call safe_alloc_ptr(CS%avg_time,CS%num_cycle) ; CS%avg_time(:) = 0.0 - vd = var_desc("avg_time","sec","Cyclical accumulated averaging time", & - '1',z_grid='1',t_grid=period_str) - call register_restart_field(CS%avg_time, vd, .false., restart_CS) - - call safe_alloc_ptr(CS%avg_SST_anom,isd,ied,jsd,jed,CS%num_cycle) ; CS%avg_SST_anom(:,:,:) = 0.0 - call safe_alloc_ptr(CS%avg_SSS_anom,isd,ied,jsd,jed,CS%num_cycle) ; CS%avg_SSS_anom(:,:,:) = 0.0 - vd = var_desc("avg_SST_anom","deg C","Cyclical average SST Anomaly", & - z_grid='1',t_grid=period_str) - call register_restart_field(CS%avg_SST_anom, vd, .false., restart_CS) - vd = var_desc("avg_SSS_anom","g kg-1","Cyclical average SSS Anomaly", & - z_grid='1',t_grid=period_str) - call register_restart_field(CS%avg_SSS_anom, vd, .false., restart_CS) + + call register_restart_field(CS%heat_cyc, "Ctrl_heat_cycle", .false., restart_CS, & + longname="Cyclical Control Heating", units="W m-2", z_grid='1', t_grid=period_str) + call register_restart_field(CS%precip_cyc, "Ctrl_precip_cycle", .false., restart_CS, & + longname="Cyclical Control Precipitation", units="kg m-2 s-1", z_grid='1', t_grid=period_str) + call register_restart_field(CS%avg_time, "avg_time", .false., restart_CS, & + longname="Cyclical accumulated averaging time", units="sec", z_grid='1', t_grid=period_str) + call register_restart_field(CS%avg_SST_anom, "avg_SST_anom", .false., restart_CS, & + longname="Cyclical average SST Anomaly", units="deg C", z_grid='1', t_grid=period_str) + call register_restart_field(CS%avg_SSS_anom, "avg_SSS_anom", .false., restart_CS, & + longname="Cyclical average SSS Anomaly", units="g kg-1", z_grid='1', t_grid=period_str) endif end subroutine register_ctrl_forcing_restarts !> Set up this modules control structure. -subroutine controlled_forcing_init(Time, G, param_file, diag, CS) +subroutine controlled_forcing_init(Time, G, US, 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(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. @@ -491,13 +509,20 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) !! diagnostic output. type(ctrl_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. - real :: smooth_len + + ! Local variables + real :: smooth_len ! A smoothing lengthscale [L ~> m] + real :: RZ_T_rescale ! Unit conversion factor for precipiation [T kg m-2 s-1 R-1 Z-1 ~> 1] + real :: QRZ_T_rescale ! Unit conversion factor for head fluxes [T W m-2 Q-1 R-1 Z-1 ~> 1] logical :: do_integrated integer :: num_cycle -! This include declares and sets the variable "version". -#include "version_variable.h" + integer :: i, j, isc, iec, jsc, jec, m + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_controlled_forcing" ! This module's name. + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + ! These should have already been called. ! call read_param(param_file, "CTRL_FORCE_INTEGRATED", CS%do_integrated) ! call read_param(param_file, "CTRL_FORCE_NUM_CYCLE", CS%num_cycle) @@ -523,40 +548,96 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag call get_param(param_file, mdl, "CTRL_FORCE_HEAT_INT_RATE", CS%heat_int_rate, & - "The integrated rate at which heat flux anomalies are "//& - "accumulated.", units="s-1", default=0.0) + "The integrated rate at which heat flux anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_PREC_INT_RATE", CS%prec_int_rate, & - "The integrated rate at which precipitation anomalies "//& - "are accumulated.", units="s-1", default=0.0) + "The integrated rate at which precipitation anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_HEAT_CYC_RATE", CS%heat_cyc_rate, & - "The integrated rate at which cyclical heat flux "//& - "anomalies are accumulated.", units="s-1", default=0.0) + "The integrated rate at which cyclical heat flux anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_PREC_CYC_RATE", CS%prec_cyc_rate, & - "The integrated rate at which cyclical precipitation "//& - "anomalies are accumulated.", units="s-1", default=0.0) + "The integrated rate at which cyclical precipitation anomalies are accumulated.", & + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "CTRL_FORCE_SMOOTH_LENGTH", smooth_len, & - "The length scales over which controlled forcing "//& - "anomalies are smoothed.", units="m", default=0.0) + "The length scales over which controlled forcing anomalies are smoothed.", & + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_HEAT", CS%lam_heat, & "A constant of proportionality between SST anomalies "//& - "and controlling heat fluxes", "W m-2 K-1", default=0.0) + "and controlling heat fluxes", & + units="W m-2 K-1", default=0.0, scale=US%W_m2_to_QRZ_T) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_PREC", CS%lam_prec, & "A constant of proportionality between SSS anomalies "//& "(normalised by mean SSS) and controlling precipitation.", & - "kg m-2", default=0.0) + units="kg m-2 s-1", default=0.0, scale=US%kg_m2s_to_RZ_T) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_HEAT", CS%lam_cyc_heat, & "A constant of proportionality between SST anomalies "//& - "and cyclical controlling heat fluxes", "W m-2 K-1", default=0.0) + "and cyclical controlling heat fluxes", & + units="W m-2 K-1", default=0.0, scale=US%W_m2_to_QRZ_T) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_PREC", CS%lam_cyc_prec, & "A constant of proportionality between SSS anomalies "//& - "(normalised by mean SSS) and cyclical controlling "//& - "precipitation.", "kg m-2", default=0.0) + "(normalised by mean SSS) and cyclical controlling precipitation.", & + units="kg m-2 s-1", default=0.0, scale=US%kg_m2s_to_RZ_T) CS%Len2 = smooth_len**2 -! ### REPLACE THIS WITH ANY DIAGNOSTICS FROM THIS MODULE. -! CS%id_taux = register_diag_field('ocean_model', 'taux', diag%axesu1, Time, & -! 'Zonal Wind Stress', 'Pascal') + if (CS%do_integrated) then + CS%id_heat_0 = register_diag_field('ocean_model', 'Ctrl_heat', diag%axesT1, Time, & + 'Control Corrective Heating', 'W m-2', conversion=US%QRZ_T_to_W_m2) + CS%id_prec_0 = register_diag_field('ocean_model', 'Ctrl_prec', diag%axesT1, Time, & + 'Control Corrective Precipitation', 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) + endif + + ! Rescale if there are differences between the dimensional scaling of variables in + ! restart files from those in use for this run. + if ((US%J_kg_to_Q_restart*US%kg_m3_to_R_restart*US%m_to_Z_restart*US%s_to_T_restart /= 0.0) .and. & + ((US%J_kg_to_Q * US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) /= & + (US%J_kg_to_Q_restart * US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T)) ) then + ! Redo the scaling of the corrective heat fluxes to [Q R Z T-1 ~> W m-2] + QRZ_T_rescale = (US%J_kg_to_Q * US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) / & + (US%J_kg_to_Q_restart * US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T) + + if (associated(CS%heat_0)) then + do j=jsc,jec ; do i=isc,iec + CS%heat_0(i,j) = QRZ_T_rescale * CS%heat_0(i,j) + enddo ; enddo + endif + + if ((CS%num_cycle > 0) .and. associated(CS%heat_cyc)) then + do m=1,CS%num_cycle ; do j=jsc,jec ; do i=isc,iec + CS%heat_cyc(i,j,m) = QRZ_T_rescale * CS%heat_cyc(i,j,m) + enddo ; enddo ; enddo + endif + endif + + if ((US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T_restart /= 0.0) .and. & + ((US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) /= & + (US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T)) ) then + ! Redo the scaling of the corrective precipitation to [R Z T-1 ~> kg m-2 s-1] + RZ_T_rescale = (US%kg_m3_to_R * US%m_to_Z * US%s_to_T_restart) / & + (US%kg_m3_to_R_restart * US%m_to_Z_restart * US%s_to_T) + + if (associated(CS%precip_0)) then + do j=jsc,jec ; do i=isc,iec + CS%precip_0(i,j) = RZ_T_rescale * CS%precip_0(i,j) + enddo ; enddo + endif + + if ((CS%num_cycle > 0) .and. associated(CS%precip_cyc)) then + do m=1,CS%num_cycle ; do j=jsc,jec ; do i=isc,iec + CS%precip_cyc(i,j,m) = RZ_T_rescale * CS%precip_cyc(i,j,m) + enddo ; enddo ; enddo + endif + endif + + if ((CS%num_cycle > 0) .and. associated(CS%avg_time) .and. & + ((US%s_to_T_restart /= 0.0) .and. ((US%s_to_T_restart) /= US%s_to_T)) ) then + ! Redo the scaling of the accumulated times to [T ~> s] + do m=1,CS%num_cycle + CS%avg_time(m) = (US%s_to_T / US%s_to_T_restart) * CS%avg_time(m) + enddo + endif + end subroutine controlled_forcing_init diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index b955f75a32..30c30f264a 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -34,18 +34,18 @@ module benchmark_initialization subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth in [m] or [Z ~> m] if US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D + real, intent(in) :: max_depth !< Maximum model depth in the units of D, [m] or [Z ~> m] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths [Z ~> m]. - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: D0 ! A constant to make the maximum ! - ! basin depth MAXIMUM_DEPTH. ! - real :: m_to_Z ! A dimensional rescaling factor. - real :: x, y + real :: min_depth ! The minimum basin depth [m] or [Z ~> m] + real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [m] or [Z ~> m] + real :: m_to_Z ! A dimensional rescaling factor [Z m-1 ~> 1] + real :: x ! Longitude relative to the domain edge, normalized by its extent [nondim] + real :: y ! Latitude relative to the domain edge, normalized by its extent [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "benchmark_initialize_topography" ! This subroutine's name. @@ -118,10 +118,13 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e real :: a_exp ! The fraction of the overall stratification that is exponential. real :: I_ts, I_md ! Inverse lengthscales [Z-1 ~> m-1]. real :: T_frac ! A ratio of the interface temperature to the range - ! between SST and the bottom temperature. - real :: err, derr_dz ! The error between the profile's temperature and the - ! interface temperature for a given z and its derivative. - real :: pi, z + ! between SST and the bottom temperature [nondim]. + real :: err ! The normalized error between the profile's temperature and the + ! interface temperature for a given z [nondim] + real :: derr_dz ! The derivative of the normalized error between the profile's + ! temperature and the interface temperature with z [Z-1 ~> m-1] + real :: pi ! 3.1415926... calculated as 4*atan(1) + real :: z ! A work variable for the interface position [Z ~> m] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "benchmark_initialize_thickness" ! This subroutine's name. @@ -178,9 +181,10 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e do k=1,nz ; e_pert(K) = 0.0 ; enddo ! This sets the initial thickness (in [H ~> m or kg m-2]) of the layers. The thicknesses - ! are set to insure that: 1. each layer is at least Gv%Angstrom_m thick, and - ! 2. the interfaces are where they should be based on the resting depths and interface - ! height perturbations, as long at this doesn't interfere with 1. + ! are set to insure that: + ! 1. each layer is at least GV%Angstrom_H thick, and + ! 2. the interfaces are where they should be based on the resting depths and + ! interface height perturbations, as long at this doesn't interfere with 1. eta1D(nz+1) = -depth_tot(i,j) do k=nz,2,-1 @@ -214,8 +218,8 @@ end subroutine benchmark_initialize_thickness !> Initializes layer temperatures and salinities for benchmark subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & eqn_of_state, P_Ref, just_read) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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 @@ -226,19 +230,18 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & !! model parameter values. type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure [R L2 T-2 ~> Pa]. + !! reference pressure [R L2 T-2 ~> Pa] logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T & S. ! Local variables 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 + 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] character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 693d2b5ceb..a1d8bf4b52 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -52,7 +52,7 @@ subroutine dumbbell_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] 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(dumbbell_surface_forcing_CS), pointer :: CS !< A control structure returned by a previous @@ -126,7 +126,7 @@ subroutine dumbbell_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) end subroutine dumbbell_buoyancy_forcing !> Dynamic forcing for the dumbbell test case -subroutine dumbbell_dynamic_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine dumbbell_dynamic_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any @@ -134,15 +134,17 @@ subroutine dumbbell_dynamic_forcing(sfc_state, fluxes, day, dt, G, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply [s] + !! the fluxes apply [T ~> s] 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(dumbbell_surface_forcing_CS), pointer :: CS !< A control structure returned by a previous !! call to dumbbell_surface_forcing_init ! Local variables integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed integer :: idays, isecs - real :: deg_rad, rdays + real :: deg_rad ! A conversion factor from degrees to radians [nondim] + real :: rdays ! The elapsed time [days] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -178,11 +180,12 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) type(dumbbell_surface_forcing_CS), & pointer :: CS !< A pointer to the control structure for this module ! Local variables - real :: S_surf, S_range - real :: x, y + real :: S_surf ! Initial surface salinity [ppt] + real :: S_range ! Range of the initial vertical distribution of salinity [ppt] + real :: x, y ! Latitude and longitude normalized by the domain size [nondim] integer :: i, j logical :: dbrotate ! If true, rotate the domain. -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "dumbbell_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index bf31ca02f8..eb9694a091 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -24,9 +24,6 @@ module user_revise_forcing real :: cdrag !< The quadratic bottom drag coefficient. end type user_revise_forcing_CS -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "user_revise_forcing" !< This module's name. contains !> This subroutine sets the surface wind stresses. @@ -41,6 +38,7 @@ subroutine user_alter_forcing(sfc_state, fluxes, day, G, CS) type(user_revise_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! surface_forcing_init. + return end subroutine user_alter_forcing @@ -52,6 +50,10 @@ subroutine user_revise_forcing_init(param_file,CS) !! returned by a previous call to !! surface_forcing_init. + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "user_revise_forcing" !< This module's name. + call log_version(param_file, mdl, version) end subroutine user_revise_forcing_init From 833cd301042e9ef95c3215a62595f800077a7cbd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 10:01:34 -0500 Subject: [PATCH 095/138] +Remove clocks inside of j-loops Removed clocks that were being called from inside of j-loops in two modules. These are inefficient and can cause the model to hang in some cases if used, and there are better ways to get timing information at this level. If there is interest in the timing breakdown at this level, the code should be restructured to move the key blocks outside of the j-loops. The run-time parameter ALLOW_CLOCKS_IN_OMP_LOOPS is no longer being used so it is now obsoleted. All answers are bitwise identical, but there are changes to some MOM_parameter_doc files. --- src/diagnostics/MOM_obsolete_params.F90 | 1 + .../vertical/MOM_bulk_mixed_layer.F90 | 54 +------------------ .../vertical/MOM_regularize_layers.F90 | 18 +------ 3 files changed, 5 insertions(+), 68 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 034b87e91b..c579241ffe 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -87,6 +87,7 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) + call obsolete_logical(param_file, "ALLOW_CLOCKS_IN_OMP_LOOPS", .true.) call obsolete_logical(param_file, "LARGE_FILE_SUPPORT", .true.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index c80ee0ea61..046329523d 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -136,8 +136,6 @@ module MOM_bulk_mixed_layer !! detrainment [R Z L2 T-3 ~> W m-2]. diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only !! detrainment [R Z L2 T-3 ~> W m-2]. - logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can - !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass !>@{ Diagnostic IDs @@ -150,8 +148,7 @@ module MOM_bulk_mixed_layer end type bulkmixedlayer_CS !>@{ CPU clock IDs -integer :: id_clock_detrain=0, id_clock_mech=0, id_clock_conv=0, id_clock_adjustment=0 -integer :: id_clock_EOS=0, id_clock_resort=0, id_clock_pass=0 +integer :: id_clock_pass=0 !>@} contains @@ -433,7 +430,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 enddo ; enddo - if (id_clock_EOS>0) call cpu_clock_begin(id_clock_EOS) ! Calculate an estimate of the mid-mixed layer pressure [R L2 T-2 ~> Pa] if (associated(tv%p_surf)) then do i=is,ie ; p_ref(i) = tv%p_surf(i,j) ; enddo @@ -449,27 +445,22 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), tv%eqn_of_state, EOSdom) call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo - if (id_clock_EOS>0) call cpu_clock_end(id_clock_EOS) if (CS%ML_resort) then - if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) if (CS%ML_presort_nz_conv_adj > 0) & call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, & US, CS, CS%ML_presort_nz_conv_adj) call sort_ML(h, R0, eps, G, GV, CS, ksort) - if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) else do k=1,nz ; do i=is,ie ; ksort(i,k) = k ; enddo ; enddo - if (id_clock_adjustment>0) call cpu_clock_begin(id_clock_adjustment) ! Undergo instantaneous entrainment into the buffer layers and mixed layers ! to remove hydrostatic instabilities. Any water that is lighter than ! currently in the mixed or buffer layer is entrained. call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS) do i=is,ie ; h_CA(i) = h(i,1) ; enddo - if (id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) endif if (associated(fluxes%lrunoff) .and. CS%do_rivermix) then @@ -493,9 +484,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C do i=is,ie ; TKE_river(i) = 0.0 ; enddo endif - - if (id_clock_conv>0) call cpu_clock_begin(id_clock_conv) - ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes @@ -515,16 +503,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C nsw, Pen_SW_bnd, opacity_band, Conv_En, dKE_FC, & j, ksort, G, GV, US, CS, tv, fluxes, dt, aggregate_FW_forcing) - if (id_clock_conv>0) call cpu_clock_end(id_clock_conv) - ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the ! surface is becoming lighter, and is effecti1336vely detraining. ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. - if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) - call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, US, CS) @@ -542,7 +526,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (CS%TKE_diagnostics) then ; do i=is,ie CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag * TKE(i) enddo ; endif - if (id_clock_mech>0) call cpu_clock_end(id_clock_mech) ! Calculate the homogeneous mixed layer properties and store them in layer 0. do i=is,ie ; if (htot(i) > 0.0) then @@ -572,10 +555,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! these unused layers (but not currently in the code). if (CS%ML_resort) then - if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) call resort_ML(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), GV%Rlay(:), eps, & d_ea, d_eb, ksort, G, GV, CS, dR0_dT, dR0_dS, dRcv_dT, dRcv_dS) - if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) endif if (CS%limit_det .or. (CS%id_Hsfc_max > 0) .or. (CS%id_Hsfc_min > 0)) then @@ -606,7 +587,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Move water left in the former mixed layer into the buffer layer and ! from the buffer layer into the interior. These steps might best be ! treated in conjuction. - if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & GV%Rlay(:), dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & @@ -619,8 +599,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! This code only works with 1 or 2 buffer layers. call MOM_error(FATAL, "MOM_mixed_layer: CS%nkbl must be 1 or 2 for now.") endif - if (id_clock_detrain>0) call cpu_clock_end(id_clock_detrain) - if (CS%id_Hsfc_used > 0) then do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo @@ -3526,12 +3504,6 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "If true, use code with a bug that causes a loss of momentum conservation "//& "during mixedlayer convection.", default=.false.) - call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", & - CS%allow_clocks_in_omp_loops, & - "If true, clocks can be called from inside loops that can "//& - "be threaded. To run with multiple threads, set to False.", & - default=.true.) - CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & @@ -3610,30 +3582,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) if (CS%id_PE_detrain2 > 0) call safe_alloc_alloc(CS%diag_PE_detrain2, isd, ied, jsd, jed) if (CS%id_ML_depth > 0) call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - if (CS%allow_clocks_in_omp_loops) then - id_clock_detrain = cpu_clock_id('(Ocean mixed layer detrain)', & - sync=.false., grain=CLOCK_ROUTINE) - id_clock_mech = cpu_clock_id('(Ocean mixed layer mechanical entrainment)', & - sync=.false., grain=CLOCK_ROUTINE) - id_clock_conv = cpu_clock_id('(Ocean mixed layer convection)', & - sync=.false., grain=CLOCK_ROUTINE) - if (CS%ML_resort) then - id_clock_resort = cpu_clock_id('(Ocean mixed layer resorting)', & - sync=.false., grain=CLOCK_ROUTINE) - else - id_clock_adjustment = cpu_clock_id('(Ocean mixed layer convective adjustment)', & - sync=.false., grain=CLOCK_ROUTINE) - endif - id_clock_EOS = cpu_clock_id('(Ocean mixed layer EOS)', & - sync=.false., grain=CLOCK_ROUTINE) - endif - if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) & - id_clock_pass = cpu_clock_id('(Ocean mixed layer halo updates)', grain=CLOCK_ROUTINE) - - -! if (CS%limit_det) then -! endif + id_clock_pass = cpu_clock_id('(Ocean mixed layer halo updates)', grain=CLOCK_ROUTINE) end subroutine bulkmixedlayer_init diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 868ff6a832..1f141ffd0f 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -56,13 +56,11 @@ module MOM_regularize_layers logical :: debug !< If true, do more thorough checks for debugging purposes. integer :: id_def_rat = -1 !< A diagnostic ID - logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that - !! can be threaded. To run with multiple threads, set to False. end type regularize_layers_CS !>@{ Clock IDs !! \todo Should these be global? -integer :: id_clock_pass, id_clock_EOS +integer :: id_clock_pass !>@} contains @@ -233,12 +231,10 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) ! Now restructure the layers. !$OMP parallel do default(private) shared(is,ie,js,je,nz,do_j,def_rat_h,CS,nkmb,G,GV,US, & !$OMP e,I_dtol,h,tv,debug,h_neglect,p_ref_cv,ea, & - !$OMP eb,id_clock_EOS,nkml,EOSdom) + !$OMP eb,nkml,EOSdom) do j=js,je ; if (do_j(j)) then -! call cpu_clock_begin(id_clock_EOS) ! call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, EOSdom) -! call cpu_clock_end(id_clock_EOS) do k=1,nz ; do i=is,ie ; d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 ; enddo ; enddo kmax_d_ea = 0 @@ -367,11 +363,9 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) enddo endif if (det_any) then - call cpu_clock_begin(id_clock_EOS) do k=1,nkmb call calculate_density(T_2d(:,k), S_2d(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo - call cpu_clock_end(id_clock_EOS) do i=is,ie ; if (det_i(i)) then k1 = nkmb ; k2 = nz @@ -780,19 +774,11 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) ! call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debug, & ! "If true, monitor conservation and extrema.", default=.false., do_not_log=just_read) - call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", CS%allow_clocks_in_omp_loops, & - "If true, clocks can be called from inside loops that can "//& - "be threaded. To run with multiple threads, set to False.", & - default=.true., do_not_log=just_read) - if (.not.CS%regularize_surface_layers) return CS%id_def_rat = register_diag_field('ocean_model', 'deficit_ratio', diag%axesT1, & Time, 'Max face thickness deficit ratio', 'nondim') - if (CS%allow_clocks_in_omp_loops) then - id_clock_EOS = cpu_clock_id('(Ocean regularize_layers EOS)', grain=CLOCK_ROUTINE) - endif id_clock_pass = cpu_clock_id('(Ocean regularize_layers halo updates)', grain=CLOCK_ROUTINE) end subroutine regularize_layers_init From 8b5c1c87ff114e85fb53a8d54b7bc49c1ada666f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 10:10:18 -0500 Subject: [PATCH 096/138] Deallocate eta_PF_start to avoid a memory leak Added a deallocate call for eta_PF_start in step_MOM_dyn_split_RK2() to avoid a possible memory leak. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d3ad0a0a92..a762da7f33 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -865,11 +865,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ; enddo enddo - ! The time-averaged free surface height has already been set by the last - ! call to btstep. + ! The time-averaged free surface height has already been set by the last call to btstep. - ! Deallocate this memory to avoid a memory leak. ###We should also revisit how this array is declared. - RWH - !### if (dyn_p_surf .and. associated(eta_PF_start)) deallocate(eta_PF_start) + ! Deallocate this memory to avoid a memory leak. ### We should revisit how this array is declared. -RWH + if (dyn_p_surf .and. associated(eta_PF_start)) deallocate(eta_PF_start) ! Here various terms used in to update the momentum equations are ! offered for time averaging. From 3f46b6a7f060a563a2ebb6be77ca86eedc44cfbe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 12:25:30 -0500 Subject: [PATCH 097/138] +Set find_salt_root if SHELF_THREE_EQN = .False. Set find_salt_root even if SHELF_THREE_EQN = .False. to avoid using an uninitialized logical to determine which parameters are logged. Without this the contents of some MOM_parameter_doc.all files could depend on the state of uninitialized memory and was compiler dependent in some cases. All answers are bitwise identical, but in some cases the contents of MOM_parameter_doc files could be corrected. --- src/ice_shelf/MOM_ice_shelf.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 77166cece0..bbc23bdc5e 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1409,12 +1409,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "If true, user specifies a constant nondimensional heat-transfer coefficient "//& "(GAMMA_T_3EQ), from which the default salt-transfer coefficient is set "//& "as GAMMA_T_3EQ/35. This is used with SHELF_THREE_EQN.", default=.false.) - if (CS%threeeq) then - call get_param(param_file, mdl, "SHELF_S_ROOT", CS%find_salt_root, & + call get_param(param_file, mdl, "SHELF_S_ROOT", CS%find_salt_root, & "If SHELF_S_ROOT = True, salinity at the ice/ocean interface (Sbdry) "//& "is computed from a quadratic equation. Otherwise, the previous "//& - "interactive method to estimate Sbdry is used.", default=.false.) - else + "interactive method to estimate Sbdry is used.", & + default=.false., do_not_log=.not.CS%threeeq) + if (.not.CS%threeeq) then call get_param(param_file, mdl, "SHELF_2EQ_GAMMA_T", CS%gamma_t, & "If SHELF_THREE_EQN is false, this the fixed turbulent "//& "exchange velocity at the ice-ocean interface.", & From ec553aa93c59538da6387f1f7c173848f0ade1ef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 12:27:34 -0500 Subject: [PATCH 098/138] +Obsolete ETA_TOLERANCE_AUX The runtime parameter ETA_TOLERANCE_AUX was being read but was never used, so it is being obsoleted. However, because some experiments were using this and there are effectively no changes in behavior, a warning will be issued instead of a fatal error if this parameter is set. All answers are bitwise identical, but there are changes to some MOM_parameter_doc files. --- src/core/MOM_continuity_PPM.F90 | 22 +++++----------------- src/diagnostics/MOM_obsolete_params.F90 | 9 +++++++-- 2 files changed, 12 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 4e037998c9..15a6bf72a3 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -41,10 +41,6 @@ module MOM_continuity_PPM real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses [L T-1 ~> m s-1]. - real :: tol_eta_aux !< The tolerance for free-surface height - !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses when calculating - !! the auxiliary corrected velocities [H ~> m or kg m-2]. real :: CFL_limit_adjust !< The maximum CFL of the adjusted velocities [nondim] logical :: aggress_adjust !< If true, allow the adjusted velocities to have a !! relative CFL change up to 0.5. False by default. @@ -2234,9 +2230,9 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to !! regulate diagnostic output. type(continuity_PPM_CS), intent(inout) :: CS !< Module's control structure. -!> This include declares and sets the variable "version". -#include "version_variable.h" - real :: tol_eta_m ! An unscaled version of tol_eta [m]. + + !> This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. CS%initialized = .true. @@ -2267,16 +2263,8 @@ 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*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, & - "The tolerance for free-surface height discrepancies "//& - "between the barotropic solution and the sum of the "//& - "layer thicknesses when calculating the auxiliary "//& - "corrected velocities. By default, this is the same as "//& - "ETA_TOLERANCE, but can be made larger for efficiency.", & - units="m", default=tol_eta_m, scale=GV%m_to_H) + default=0.5*GV%ke*GV%Angstrom_m) + call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies "//& "between the barotropic solution and the sum of the "//& diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index c579241ffe..dfadaa1da5 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -80,6 +80,7 @@ subroutine find_obsolete_params(param_file) "find_obsolete_params: #define DYNAMIC_SURFACE_PRESSURE is not yet "//& "implemented without #define SPLIT.") + call obsolete_real(param_file, "ETA_TOLERANCE_AUX", only_warn=.true.) call obsolete_real(param_file, "BT_MASS_SOURCE_LIMIT", 0.0) call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") @@ -174,21 +175,25 @@ subroutine obsolete_char(param_file, varname, warning_val, hint) end subroutine obsolete_char !> Test for presence of obsolete REAL in parameter file. -subroutine obsolete_real(param_file, varname, warning_val, hint) +subroutine obsolete_real(param_file, varname, warning_val, hint, only_warn) type(param_file_type), intent(in) :: param_file !< Structure containing parameter file data. character(len=*), intent(in) :: varname !< Name of obsolete REAL parameter. real, optional, intent(in) :: warning_val !< An allowed value that causes a warning instead of an error. character(len=*), optional, intent(in) :: hint !< A hint to the user about what to do. + logical, optional, intent(in) :: only_warn !< If present and true, issue warnings instead of fatal errors. + ! Local variables real :: test_val, warn_val + logical :: issue_warning character(len=128) :: hint_msg test_val = -9e35; call read_param(param_file, varname, test_val) warn_val = -9e35; if (present(warning_val)) warn_val = warning_val hint_msg = " " ; if (present(hint)) hint_msg = hint + issue_warning = .false. ; if (present(only_warn)) issue_warning = only_warn if (test_val /= -9e35) then - if (test_val == warn_val) then + if ((test_val == warn_val) .or. issue_warning) then call MOM_ERROR(WARNING, "MOM_obsolete_params: "//trim(varname)// & " is an obsolete run-time flag. "//trim(hint_msg)) else From d7337145ec3ae4aef8b4a9d6030672a8c1ed336c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 10:09:26 -0500 Subject: [PATCH 099/138] (*)Fix extract_diabatic_member Return the diabatic_aux_CSp from extract_diabatic_member it is present as an optional argument. Somehow this was omitted when this routine was created, but without this correction the offline tracer mode returns a segmentation fault. Also, added the proper conversion factor in the register_diag_field call for e_predia, and internally calculate the interface heights in units of [Z ~> m] for dimensional consistency testing. All answers are bitwise identical in cases that ran before. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 77ec87b230..1b68cf8211 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -294,7 +294,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & - eta ! Interface heights before diapycnal mixing [m]. + eta ! Interface heights before diapycnal mixing [Z ~> m] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn_IGW ! baroclinic internal gravity wave speeds [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: temp_diag ! Previous temperature for diagnostics [degC] @@ -326,7 +326,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -2536,6 +2536,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL + if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit @@ -3175,7 +3176,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Layer Thickness before diabatic forcing', & trim(thickness_units), conversion=GV%H_to_MKS, v_extensive=.true.) CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & - 'Interface Heights before diabatic forcing', 'm') + 'Interface Heights before diabatic forcing', 'm', conversion=US%Z_to_m) if (use_temperature) then CS%id_T_predia = register_diag_field('ocean_model', 'temp_predia', diag%axesTL, Time, & 'Potential Temperature', 'degC') From 5172c495c3505a7565448d91ff48c487148f5500 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 10:10:16 -0500 Subject: [PATCH 100/138] Warn if opacity_from_chl is called without fluxes Issue a warning with a helpful message if opacity_from_chl is called with no shortwave fluxes, and added logical tests to avoid a segmentation fault later in this routine. This should not happen, as it makes no sense, but it was occurring with the offline tracer code, and can be avoided by setting PEN_SW_NBANDS=0 if there are no shortwave fluxes to penetrate. Also turned the real dimensional parameter op_diag_len into a variable and set it immediately before where it is used. Many spelling errors were also corrected in MOM_opacity.F90. All answers are identical in cases that ran before. --- .../vertical/MOM_opacity.F90 | 89 +++++++++++-------- 1 file changed, 52 insertions(+), 37 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 02d49d024d..a99524060b 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -47,7 +47,7 @@ module MOM_opacity end type optics_type -!> The control structure with paramters for the MOM_opacity module +!> The control structure with parameters for the MOM_opacity module type, public :: opacity_CS ; private logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified by OPACITY_SCHEME) to !! determine the e-folding depth of incoming shortwave radiation. @@ -67,6 +67,7 @@ module MOM_opacity !! The default is 10 m-1 - a value for muddy water. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. + logical :: warning_issued !< A flag that is used to avoid repetative warnings. !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1 @@ -83,9 +84,6 @@ module MOM_opacity character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" !< String to specify the opacity scheme character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" !< String to specify the opacity scheme -real, parameter :: op_diag_len = 1e-10 !< Lengthscale L used to remap opacity - !! from op to 1/L * tanh(op * L) - contains !> This sets the opacity of sea water based based on one of several different schemes. @@ -103,24 +101,26 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(opacity_CS) :: CS !< The control structure earlier set up by opacity_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentrations [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] + optional, intent(in) :: chl_3d !< The chlorophyll-A concentrations of each layer [mg m-3] ! Local variables integer :: i, j, k, n, is, ie, js, je, nz real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating - ! shortwave radiation. + ! shortwave radiation [nondim] logical :: call_for_surface ! if horizontal slice is the surface layer real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [Q R Z T-1 ~> W m-2]. + real :: op_diag_len ! A tiny lengthscale [m] used to remap opacity + ! from op to 1/op_diag_len * tanh(op * op_diag_len) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(chl_2d) .or. present(chl_3d)) then - ! The optical properties are based on cholophyll concentrations. + ! The optical properties are based on chlorophyll concentrations. call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & G, GV, US, CS, chl_2d, chl_3d) else ! Use sw e-folding scale set by MOM_input @@ -199,11 +199,12 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ call post_data(CS%id_sw_vis_pen, Pen_SW_tot, CS%diag) endif do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then + op_diag_len = 1e-10 ! A dimensional depth to constrain the range of opacity [m] !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie ! Remap opacity (op) to 1/L * tanh(op * L) where L is one Angstrom. ! This gives a nearly identical value when op << 1/L but allows one to - ! store the values when opacity is divergent (i.e. opaque). + ! record the values even at reduced precision when opacity is huge (i.e. opaque). tmp(i,j,k) = tanh(op_diag_len * optics%opacity_band(n,i,j,k)) / op_diag_len enddo ; enddo ; enddo call post_data(CS%id_opacity(n), tmp, CS%diag) @@ -213,12 +214,12 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ end subroutine set_opacity -!> This sets the "blue" band opacity based on chloophyll A concencentrations +!> This sets the "blue" band opacity based on chlorophyll A concentrations !! The red portion is lumped into the net heating at the surface. subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & G, GV, US, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values - !! set based on the opacities. + !! set based on the opacities. real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [Q R Z T-1 ~> W m-2] real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [Q R Z T-1 ~> W m-2] real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [Q R Z T-1 ~> W m-2] @@ -229,15 +230,15 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(opacity_CS) :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentrations [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentrations [mg m-3] real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating - ! shortwave radiation. + ! shortwave radiation [nondim] real :: Inv_nbands_nir ! The inverse of the number of bands of penetrating - ! near-infrafed radiation. + ! near-infrared radiation [nondim] real :: SW_pen_tot ! The sum across the bands of the penetrating ! shortwave radiation [Q R Z T-1 ~> W m-2]. real :: SW_vis_tot ! The sum across the visible bands of shortwave @@ -247,7 +248,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir type(time_type) :: day character(len=128) :: mesg integer :: i, j, k, n, is, ie, js, je, nz, nbands - logical :: multiband_vis_input, multiband_nir_input + logical :: multiband_vis_input, multiband_nir_input, total_sw_input is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -257,9 +258,9 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir ! into the net heating at the surface. ! ! Morel, A., Optical modeling of the upper ocean in relation to its biogenous -! matter content (case-i waters).,J. Geo. Res., {93}, 10,749--10,768, 1988. +! matter content (case-i waters)., J. Geo. Res., {93}, 10,749--10,768, 1988. ! -! Manizza, M., C.~L. Quere, A.~Watson, and E.~T. Buitenhuis, Bio-optical +! Manizza, M., C. L. Quere, A. Watson, and E. T. Buitenhuis, Bio-optical ! feedbacks among phytoplankton, upper ocean physics and sea-ice in a ! global model, Geophys. Res. Let., , L05,603, 2005. @@ -271,10 +272,19 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir if (nbands <= 2) then ; Inv_nbands_nir = 0.0 else ; Inv_nbands_nir = 1.0 / real(nbands - 2.0) ; endif - multiband_vis_input = (associated(sw_vis_dir) .and. & - associated(sw_vis_dif)) - multiband_nir_input = (associated(sw_nir_dir) .and. & - associated(sw_nir_dif)) + if (.not.(associated(sw_total) .or. (associated(sw_vis_dir) .and. associated(sw_vis_dif) .and. & + associated(sw_nir_dir) .and. associated(sw_nir_dif)) )) then + if (.not.CS%warning_issued) then + call MOM_error(WARNING, & + "opacity_from_chl called without any shortwave flux arrays allocated.\n"//& + "Consider setting PEN_SW_NBANDS = 0 if no shortwave fluxes are being used.") + endif + CS%warning_issued = .true. + endif + + multiband_vis_input = (associated(sw_vis_dir) .and. associated(sw_vis_dif)) + multiband_nir_input = (associated(sw_nir_dir) .and. associated(sw_nir_dif)) + total_sw_input = associated(sw_total) chl_data(:,:) = 0.0 if (present(chl_3d)) then @@ -298,7 +308,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir endif enddo ; enddo else - call MOM_error(FATAL, "Either chl_2d or chl_3d must be preesnt in a call to opacity_form_chl.") + call MOM_error(FATAL, "Either chl_2d or chl_3d must be present in a call to opacity_form_chl.") endif select case (CS%opacity_scheme) @@ -309,12 +319,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir if (G%mask2dT(i,j) > 0.5) then if (multiband_vis_input) then SW_vis_tot = sw_vis_dir(i,j) + sw_vis_dif(i,j) - else ! Follow Manizza 05 in assuming that 42% of SW is visible. + elseif (total_sw_input) then + ! Follow Manizza 05 in assuming that 42% of SW is visible. SW_vis_tot = 0.42 * sw_total(i,j) endif if (multiband_nir_input) then SW_nir_tot = sw_nir_dir(i,j) + sw_nir_dif(i,j) - else + elseif (total_sw_input) then SW_nir_tot = sw_total(i,j) - SW_vis_tot endif endif @@ -333,11 +344,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir !$OMP parallel do default(shared) private(SW_pen_tot) do j=js,je ; do i=is,ie SW_pen_tot = 0.0 - if (G%mask2dT(i,j) > 0.5) then ; if (multiband_vis_input) then + if (G%mask2dT(i,j) > 0.5) then + if (multiband_vis_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * (sw_vis_dir(i,j) + sw_vis_dif(i,j)) - else + elseif (total_sw_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * 0.5*sw_total(i,j) - endif ; endif + endif + endif do n=1,nbands optics%sw_pen_band(n,i,j) = Inv_nbands*sw_pen_tot @@ -395,7 +408,7 @@ function opacity_morel(chl_data) real :: opacity_morel !< The returned opacity [m-1] ! The following are coefficients for the optical model taken from Morel and - ! Antoine (1994). These coeficients represent a non uniform distribution of + ! Antoine (1994). These coefficients represent a non uniform distribution of ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. @@ -415,7 +428,7 @@ function SW_pen_frac_morel(chl_data) real :: SW_pen_frac_morel !< The returned penetrating shortwave fraction [nondim] ! The following are coefficients for the optical model taken from Morel and - ! Antoine (1994). These coeficients represent a non uniform distribution of + ! Antoine (1994). These coefficients represent a non uniform distribution of ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. @@ -496,7 +509,7 @@ function optics_nbands(optics) optics_nbands = optics%nbands end function optics_nbands -!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inherited !! from GOLD) or throughout the water column. !! !! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total @@ -515,7 +528,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(max(1,nsw),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< Opacity in each band of penetrating !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies are band, i, k. + !! The indices are band, i, k. type(optics_type), intent(in) :: optics !< An optics structure that has values of !! opacities and shortwave fluxes. integer, intent(in) :: j !< j-index to work on. @@ -548,7 +561,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indices. real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [degC H ~> degC m or degC kg m-2] @@ -912,7 +925,7 @@ end subroutine sumSWoverBands -!> This routine initalizes the opacity module, including an optics_type. +!> This routine initializes the opacity module, including an optics_type. subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -922,7 +935,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(opacity_CS) :: CS !< Opacity control struct + type(opacity_CS) :: CS !< Opacity control structure type(optics_type) :: optics !< An optics structure that has parameters !! set and arrays allocated here. ! Local variables @@ -1083,6 +1096,8 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "The value to use for opacity over land. The default is "//& "10 m-1 - a value for muddy water.", units="m-1", default=10.0) + CS%warning_issued = .false. + if (.not.allocated(optics%opacity_band)) & allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) if (.not.allocated(optics%sw_pen_band)) & @@ -1106,7 +1121,7 @@ end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS) :: CS !< Opacity control struct + type(opacity_CS) :: CS !< Opacity control structure type(optics_type) :: optics !< An optics type structure that should be deallocated. if (allocated(CS%id_opacity)) & @@ -1125,7 +1140,7 @@ end subroutine opacity_end !! !! opacity_from_chl: !! In this routine, the Morel (modified) or Manizza (modified) -!! schemes use the "blue" band in the paramterizations to determine +!! schemes use the "blue" band in the parameterizations to determine !! the e-folding depth of the incoming shortwave attenuation. The red !! portion is lumped into the net heating at the surface. !! From 90739bea1bbf405f6d5381b174286493fc951bba Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 10:12:23 -0500 Subject: [PATCH 101/138] Correct comments describing advect_tracer args Corrected the comments describing the optional arguments to advect_tracer and fixed a few spelling errors in comments. All answers are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 16 +++++++++------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 953d64c1f0..dde2cfc988 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -119,7 +119,7 @@ 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, pbv) - type(ocean_grid_type), intent(in) :: G !< Ocen grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean 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] diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 34c8dddf04..1ad6343cf8 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -34,7 +34,7 @@ module MOM_tracer_advect logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: usePPM !< If true, use PPM instead of PLM logical :: useHuynh !< If true, use the Huynh scheme for PPM interface values - type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structred used for group passes + type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structure used for group passes end type tracer_advect_CS !>@{ CPU time clocks @@ -63,18 +63,20 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & 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_(GV)), & - optional, intent(in) :: h_prev_opt !< layer thickness before advection [H ~> m or kg m-2] + optional, intent(in) :: h_prev_opt !< Cell volume before advection [H L2 ~> m3 or kg] 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_(GV)), & - optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face + optional, intent(out) :: uhr_out !< Remaining accumulated volume/mass flux through zonal face !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face + optional, intent(out) :: vhr_out !< Remaining accumulated volume/mass flux through meridional face !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] + optional, intent(out) :: h_out !< Cell volume after the transport that was done + !! by this call [H L2 ~> m3 or kg]. If all the transport + !! could be accommodated, this is close to h_end*G%areaT. type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -380,7 +382,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. - real :: tiny_h ! The smallest numerically invertable thickness [H ~> m or kg m-2]. + real :: tiny_h ! The smallest numerically invertible thickness [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]. logical :: do_i(SZIB_(G),SZJ_(G)) ! If true, work on given points. @@ -744,7 +746,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. - real :: tiny_h ! The smallest numerically invertable thickness [H ~> m or kg m-2]. + real :: tiny_h ! The smallest numerically invertible thickness [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]. logical :: do_j_tr(SZJ_(G)) ! If true, calculate the tracer profiles. From 3364af1b8855a3c6a457e00decd0837481a1cc7c Mon Sep 17 00:00:00 2001 From: William Cooke Date: Mon, 6 Dec 2021 14:16:40 -0500 Subject: [PATCH 102/138] Update indexing of array passed to data_override. The arrays passed to data_overrride need to be sized as the compute domain. Added indices to pass to data_override. --- config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index d7c483ce49..09ba9e1156 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -1168,8 +1168,8 @@ subroutine apply_force_adjustments(G, US, CS, Time, forces) tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged overrode_x = .false. ; overrode_y = .false. - call data_override(G%Domain, 'taux_adj', tempx_at_h, Time, override=overrode_x, scale=Pa_conversion) - call data_override(G%Domain, 'tauy_adj', tempy_at_h, Time, override=overrode_y, scale=Pa_conversion) + call data_override(G%Domain, 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x, scale=Pa_conversion) + call data_override(G%Domain, 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y, scale=Pa_conversion) if (overrode_x .or. overrode_y) then if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& From 231913920d4625b2649f8d2302edfbb8276186a0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Dec 2021 14:38:57 -0500 Subject: [PATCH 103/138] Correct out of bounds index (por_face_areaU) bug Corrected the expressionfs for the por_face_areaU arguments being passed to zonal_face_thickness to avoid the array out-of-bounds index errors highlighted in MOM6 issue #24. Also added comments noting where the por_face_area arrays should probably be included in the effective (relative) face thickness calculations that are later used for finding the vertically averaged accelerations by the barotropic solver. All answers and output are bitwise identical in cases that work, but this should avoid some run-time or compile-time errors with some compiler settings. --- src/core/MOM_continuity_PPM.F90 | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 15a6bf72a3..17d2f830c0 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -223,7 +223,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & @@ -512,10 +512,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are 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, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU(:,j,k), visc_rem_u) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU, visc_rem_u) else 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, OBC, por_face_areaU(:,j,k), visc_rem_u) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU, visc_rem_u) endif endif ; endif @@ -672,9 +672,11 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else ; h_u(I,j,k) = h_avg ; endif enddo ; enddo ; enddo if (present(visc_rem_u)) then + !### The expression setting h_u should also be multiplied by por_face_areaU in this case, + ! and in the two OBC cases below with visc_rem_u. !$OMP parallel do default(shared) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh - h_u(I,j,k) = h_u(I,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h_u(I,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) enddo ; enddo ; enddo endif @@ -687,7 +689,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_E) then if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h(i,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -697,7 +699,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i+1,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h(i+1,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -1495,9 +1497,11 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, enddo ; enddo ; enddo if (present(visc_rem_v)) then + !### This expression setting h_v should also be multiplied by por_face_areaU in this case, + ! and in the two OBC cases below with visc_rem_u. !$OMP parallel do default(shared) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh - h_v(i,J,k) = h_v(i,J,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h_v(i,J,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) enddo ; enddo ; enddo endif @@ -1510,7 +1514,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_N) then if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h(i,j,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied @@ -1520,7 +1524,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j+1,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h(i,j+1,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied From 05edb63da9676efdf2907232b547a1eb20cf15c4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 15:39:04 -0500 Subject: [PATCH 104/138] (*)Offline tracer read bug fix Corrected bugs in the offline tracer code that were preventing it from reproducing across processor counts (and perhaps working sensibly at all). All answers and output in the MOM6-examples regression suite are bitwise identical. Although answers with the offline tracer code will change because of the bug fix, because of some bugs that were fixed in another recent commit, it was previously impossible to have run the offline tracer cases at all. --- src/tracer/MOM_offline_aux.F90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index af8b422238..d002393cbb 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -673,21 +673,23 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ vhtr(:,:,:) = 0.0 ! Time-summed fields call MOM_read_vector(sum_file, 'uhtr_sum', 'vhtr_sum', uhtr(:,:,1:nk_input), & - vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum) + vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum, & + scale=GV%kg_m2_to_H) call MOM_read_data(snap_file, 'h_end', h_end(:,:,1:nk_input), G%Domain, & timelevel=ridx_snap,position=CENTER) call MOM_read_data(mean_file, 'temp', temp_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) call MOM_read_data(mean_file, 'salt', salt_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) - endif - do j=js,je ; do i=is,ie - if (G%mask2dT(i,j)>0.) then - temp_mean(:,:,nk_input:nz) = temp_mean(i,j,nk_input) - salt_mean(:,:,nk_input:nz) = salt_mean(i,j,nk_input) - endif - enddo ; enddo + ! Fill temperature and salinity downward from the deepest input data. + do k=nk_input+1,nz ; do j=js,je ; do i=is,ie + if (G%mask2dT(i,j)>0.) then + temp_mean(i,j,k) = temp_mean(i,j,nk_input) + salt_mean(i,j,k) = salt_mean(i,j,nk_input) + endif + enddo ; enddo ; enddo + endif ! Check if reading vertical diffusivities or entrainment fluxes call MOM_read_data( mean_file, 'Kd_interface', Kd(:,:,1:nk_input+1), G%Domain, & From fcfd238ab3e4171a905fa4c1bd2f46ef74e4b456 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 20:52:50 -0500 Subject: [PATCH 105/138] +Refactored and rescaled the offline tracer code Substantially refactored the offline tracer code. This refactoring includes adding grid and unit_scale_type arguments to several routines related to the offline tracer code. An offline tracer advection test case is now consistent across processor layouts and pass the dimensional rescaling tests (including the chksums in debug mode), and there are comments describing all the real variables and their dimensions in the offline tracer routines. All answers and output are bitwise identical. --- config_src/drivers/solo_driver/MOM_driver.F90 | 3 +- src/ALE/MOM_ALE.F90 | 16 +- src/core/MOM.F90 | 43 +- src/tracer/MOM_offline_aux.F90 | 289 ++++---- src/tracer/MOM_offline_main.F90 | 699 +++++++++--------- 5 files changed, 544 insertions(+), 506 deletions(-) diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index ebf3e5a43d..1b88f1ce36 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -332,7 +332,8 @@ program MOM_main "The default value is given by DT.", units="s", default=dt) if (offline_tracer_mode) then call get_param(param_file, mod_name, "DT_OFFLINE", dt_forcing, & - "Time step for the offline time step") + "Length of time between reading in of input fields", & + units='s', fail_if_missing=.true.) dt = dt_forcing endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 70e152932c..9aa01738b6 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -459,21 +459,21 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) type(ALE_CS), pointer :: CS !< Regridding parameters and options type(ocean_grid_type), intent(in ) :: G !< Ocean grid informations type(verticalGrid_type), intent(in ) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses + 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 !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites [Z2 T-1 ~> m2 s-1] logical, intent(in ) :: debug !< If true, then turn checksums type(ocean_OBC_type), pointer :: OBC !< Open boundary structure ! Local variables integer :: nk, i, j, k, isc, iec, jsc, jec - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2] real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZK_(GV)) :: h_src - real, dimension(SZK_(GV)) :: h_dest, uh_dest - real, dimension(SZK_(GV)) :: temp_vec + real, dimension(SZK_(GV)) :: h_src ! Source grid thicknesses at velocity points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: h_dest ! Destination grid thicknesses at velocity points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: temp_vec ! Transports on the destination grid [H L2 ~> m3 or kg] nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec dzRegrid(:,:,:) = 0.0 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0e036d9d8f..ffce665967 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1214,7 +1214,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) @@ -1445,7 +1445,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) @@ -1490,7 +1490,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval + real, intent(in) :: time_interval !< time interval [s] type(MOM_control_struct), intent(inout) :: CS !< control structure from initialize_MOM ! Local pointers @@ -1568,17 +1568,17 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & ! CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm) ! call update_transport_from_arrays(CS%offline_CSp) - call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) + call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm) ! Apply any fluxes into the ocean call offline_fw_fluxes_into_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) if (.not.CS%diabatic_first) then - call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & - CS%h, uhtr, vhtr, converged=adv_converged) + call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport - call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then @@ -1589,23 +1589,24 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC) endif call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif endif ! The functions related to column physics of tracers is performed separately in ALE mode if (do_vertical) then - call offline_diabatic_ale(fluxes, Time_start, Time_end, CS%offline_CSp, CS%h, eatr, ebtr) + call offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS%offline_CSp, & + CS%h, eatr, ebtr) endif ! Last thing that needs to be done is the final ALE remapping if (last_iter) then if (CS%diabatic_first) then - call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & - CS%h, uhtr, vhtr, converged=adv_converged) + call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport and perform the remaining advection - call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then if (CS%VarMix%use_variable_mixing) then @@ -1625,7 +1626,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) ! These diagnostic can be used to identify which grid points did not converge within ! the specified number of advection sub iterations - call post_offline_convergence_diags(CS%offline_CSp, CS%h, h_end, uhtr, vhtr) + call post_offline_convergence_diags(G, GV, CS%offline_CSp, CS%h, h_end, uhtr, vhtr) ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses ! stored from the forward run @@ -1644,9 +1645,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif - call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) - call offline_advection_layer(fluxes, Time_start, time_interval, CS%offline_CSp, & - CS%h, eatr, ebtr, uhtr, vhtr) + call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm) + call offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then call tracer_hordiff(h_end, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & @@ -2791,10 +2792,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Setup some initial parameterizations and also assign some of the subtypes call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US) call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & - diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & - tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & + diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & + tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug ) - call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US) endif !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM @@ -3506,7 +3507,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) @@ -3515,7 +3516,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) endif diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index d002393cbb..b370dd6bb4 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -15,6 +15,7 @@ module MOM_offline_aux use MOM_io, only : MOM_read_data, MOM_read_vector, CENTER use MOM_opacity, only : optics_type use MOM_time_manager, only : time_type, operator(-) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar @@ -34,43 +35,42 @@ module MOM_offline_aux public offline_add_diurnal_sw #include "MOM_memory.h" -#include "version_variable.h" contains !> This updates thickness based on the convergence of horizontal mass fluxes !! NOTE: Only used in non-ALE mode 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 + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: uhtr !< Accumulated mass flux through zonal face [kg] + intent(in) :: uhtr !< Accumulated mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: vhtr !< Accumulated mass flux through meridional face [kg] + intent(in) :: vhtr !< Accumulated mass flux through meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_pre !< Previous layer thicknesses [kg m-2]. + intent(in) :: h_pre !< Previous layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. + intent(inout) :: h_new !< Updated layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - do k = 1, nz + do k=1,nz do i=is-1,ie+1 ; do j=js-1,je+1 - h_new(i,j,k) = max(0.0, G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k) + & - ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) + h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) enddo ; enddo enddo @@ -79,19 +79,19 @@ end subroutine update_h_horizontal_flux !> Updates layer thicknesses due to vertical mass transports !! NOTE: Only used in non-ALE configuration 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 + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< Mass of fluid entrained from the layer - !! above within this timestep [kg m-2] + !! above within this timestep [H ~> m or kg m-2] 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] + !! below within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step [kg m-2]. + !! step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. + intent(inout) :: h_new !< Updated layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -101,30 +101,21 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) ! Update h_new with convergence of vertical mass transports do j=js-1,je+1 do i=is-1,ie+1 - ! Top layer h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1) )) - h_new(i,j,1) = h_new(i,j,1) + & - max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) + h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer -! h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz)) h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) - h_new(i,j,nz) = h_new(i,j,nz) + & - max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) - + h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is-1,ie+1 - h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1)))) - h_new(i,j,k) = h_new(i,j,k) + & - max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) - + (eb(i,j,k) - ea(i,j,k+1)))) + h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo - enddo end subroutine update_h_vertical_flux @@ -132,35 +123,39 @@ end subroutine update_h_vertical_flux !> This routine limits the mass fluxes so that the a layer cannot be completely depleted. !! NOTE: Only used in non-ALE mode 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 + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Mass flux through zonal face [kg] + intent(inout) :: uh !< Mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Mass flux through meridional face [kg] + intent(inout) :: vh !< Mass flux through meridional face [H L2 ~> m3 or kg] 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] + !! above within this timestep [H ~> m or kg m-2] 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] + !! below within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step [kg m-2]. + !! step [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux, bottom_flux - real :: pos_flux, hvol, h_neglect, scale_factor, max_off_cfl + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux ! Net fluxes through the layer top [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net fluxes through the layer bottom [H ~> m or kg m-2] + real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg m-2] + real :: hvol ! Cell volume [H L2 ~> m3 or kg m-2] + real :: scale_factor ! A nondimensional rescaling factor between 0 and 1 [nondim] + real :: max_off_cfl ! The maximum permitted fraction that can leave in a timestep [nondim] - max_off_cfl =0.5 + max_off_cfl = 0.5 ! In this subroutine, fluxes out of the box are scaled away if they deplete ! the layer, note that we define the positive direction as flux out of the box. ! Hence, uh(I-1) is multipled by negative one, but uh(I) is not ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Calculate top and bottom fluxes from ea and eb. Note the explicit negative signs ! to enforce the positive out convention @@ -170,7 +165,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo - do k=2, nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=2,nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo ; enddo @@ -184,15 +179,15 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! Calculate sum of positive fluxes (negatives applied to enforce convention) ! in a given cell and scale it back if it would deplete a layer - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hvol = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + hvol = h_pre(i,j,k) * G%areaT(i,j) pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & - max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & + max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) if (pos_flux>hvol .and. pos_flux>0.0) then - scale_factor = ( hvol )/pos_flux*max_off_cfl + scale_factor = (hvol / pos_flux)*max_off_cfl else ! Don't scale scale_factor = 1.0 endif @@ -226,7 +221,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ea(i,j,k) = ea(i,j,k)*scale_factor eb(i,j,k-1) = eb(i,j,k-1)*scale_factor endif - if (bottom_flux(i,j,k)>0.0) eb(i,j,k)=eb(i,j,k)*scale_factor + if (bottom_flux(i,j,k)>0.0) eb(i,j,k) = eb(i,j,k)*scale_factor endif enddo ; enddo ; enddo @@ -235,21 +230,22 @@ end subroutine limit_mass_flux_3d !> In the case where offline advection has failed to converge, redistribute the u-flux !! into remainder of the water column as a barotropic equivalent 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 + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Zonal mass transport within a timestep [kg] + intent(inout) :: uh !< Zonal mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZK_(GV)) :: uh2d - real, dimension(SZIB_(G)) :: uh2d_sum - real, dimension(SZI_(G),SZK_(GV)) :: h2d - real, dimension(SZI_(G)) :: h2d_sum + ! Local variables + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d ! A 2-d slice of transports [H L2 ~> m3 or kg] + real, dimension(SZIB_(G)) :: uh2d_sum ! Vertically summed transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] + real, dimension(SZI_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: uh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz - real :: uh_neglect ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -269,7 +265,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) if (hvol(i,j,k)>0.) then h2d_sum(i) = h2d_sum(i) + h2d(i,k) else - h2d(i,k) = GV%H_subroundoff + h2d(i,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) endif enddo ; enddo @@ -291,10 +287,11 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) + ! ### This test may not work if GV%Angstrom_H is set to 0. + ! Instead try the max of this and ~roundoff compared with absolute transports? if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & - call MOM_error(WARNING,"Column integral of uh does not match after "//& - "barotropic redistribution") + call MOM_error(WARNING, "Column integral of uh does not match after barotropic redistribution") enddo do k=1,nz ; do i=is-1,ie @@ -306,21 +303,22 @@ end subroutine distribute_residual_uh_barotropic !> Redistribute the v-flux as a barotropic equivalent 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 + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Meridional mass transport within a timestep [kg] + intent(inout) :: vh !< Meridional mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZJB_(G),SZK_(GV)) :: vh2d - real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(GV)) :: h2d - real, dimension(SZJ_(G)) :: h2d_sum + ! Local variables + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d ! A 2-d slice of transports [H L2 ~> m3 or kg] + real, dimension(SZJB_(G)) :: vh2d_sum ! Vertically summed transports [H L2 ~> m3 or kg] + real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] + real, dimension(SZJ_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: vh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz - real :: vh_neglect ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -340,7 +338,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) if (hvol(i,j,k)>0.) then h2d_sum(j) = h2d_sum(j) + h2d(j,k) else - h2d(j,k) = GV%H_subroundoff + h2d(j,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) endif enddo ; enddo @@ -361,7 +359,9 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) + ! ### This test may not work if GV%Angstrom_H is set to 0. + ! Instead try the max of this and ~roundoff compared with absolute transports? if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") @@ -379,19 +379,21 @@ end subroutine distribute_residual_vh_barotropic !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above 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 + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Zonal mass transport within a timestep [kg] + intent(inout) :: uh !< Zonal mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZK_(GV)) :: uh2d - real, dimension(SZI_(G),SZK_(GV)) :: h2d + ! Local variables + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d ! A slice of transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A slice of updated cell volumes [H L2 ~> m3 or kg] - real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max - real :: hup, hdown, hlos, min_h + real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max ! Transports [H L2 ~> m3 or kg] + real :: hup, hlos ! Various cell volumes [H L2 ~> m3 or kg] + real :: min_h ! A minimal layer thickness [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid @@ -406,7 +408,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ; enddo do k=1,nz ; do i=is-1,ie+1 ! Subtract just a little bit of thickness to avoid roundoff errors - h2d(i,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) + h2d(i,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo do i=is-1,ie @@ -457,10 +459,9 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i+1,j)) - if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then - call MOM_error(WARNING,"Column integral of uh does not match after "//& - "upwards redistribution") + uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) + if (abs(uh_col - sum(uh2d(I,:))) > uh_neglect) then + call MOM_error(WARNING,"Column integral of uh does not match after upwards redistribution") endif enddo ! i-loop @@ -475,21 +476,23 @@ end subroutine distribute_residual_uh_upwards !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above 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 + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Meridional mass transport within a timestep [kg] - - real, dimension(SZJB_(G),SZK_(GV)) :: vh2d - real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(GV)) :: h2d - real, dimension(SZJ_(G)) :: h2d_sum + intent(inout) :: vh !< Meridional mass transport within a timestep [H L2 ~> m3 or kg] - real :: vh_neglect, vh_remain, vh_col, vh_sum - real :: hup, hlos, min_h + ! Local variables + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d ! A slice of transports [H L2 ~> m3 or kg] + real, dimension(SZJB_(G)) :: vh2d_sum ! Summed transports [H L2 ~> m3 or kg] + real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A slice of updated cell volumes [H L2 ~> m3 or kg] + real, dimension(SZJ_(G)) :: h2d_sum ! Summed cell volumes [H L2 ~> m3 or kg] + + real :: vh_neglect, vh_remain, vh_col, vh_sum ! Transports [H L2 ~> m3 or kg] + real :: hup, hlos ! Various cell volumes [H L2 ~> m3 or kg] + real :: min_h ! A minimal layer thickness [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid @@ -503,7 +506,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 - h2d(j,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) + h2d(j,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo do j=js-1,je @@ -555,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") @@ -577,12 +580,20 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) type(time_type), intent(in) :: Time_start !< The start time for this step. type(time_type), intent(in) :: Time_end !< The ending time for this step. - real :: diurnal_factor, time_since_ae, rad - real :: fracday_dt, fracday_day - real :: cosz_day, cosz_dt, rrsun_day, rrsun_dt - type(time_type) :: dt_here - - integer :: i, j, k, i2, j2, isc, iec, jsc, jec, i_off, j_off + real :: diurnal_factor ! A scaling factor to insert a synthetic diurnal cycle [nondim] + real :: time_since_ae ! Time since the autumnal equinox expressed as a fraction of a year times 2 pi [nondim] + real :: rad ! A conversion factor from degrees to radians = pi/180 degrees [nondim] + real :: fracday_dt ! Daylight fraction averaged over a timestep [nondim] + real :: fracday_day ! Daylight fraction averaged over a day [nondim] + real :: cosz_day ! Cosine of the solar zenith angle averaged over a day [nondim] + real :: cosz_dt ! Cosine of the solar zenith angle averaged over a timestep [nondim] + real :: rrsun_day ! Earth-Sun distance (r) relative to the semi-major axis of + ! the orbital ellipse averaged over a day [nondim] + real :: rrsun_dt ! Earth-Sun distance (r) relative to the semi-major axis of + ! the orbital ellipse averaged over a timestep [nondim] + type(time_type) :: dt_here ! The time increment covered by this call + + integer :: i, j, i2, j2, isc, iec, jsc, jec, i_off, j_off isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec i_off = LBOUND(fluxes%sens,1) - G%isc ; j_off = LBOUND(fluxes%sens,2) - G%jsc @@ -593,10 +604,8 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) dt_here = Time_end - Time_start rad = acos(-1.)/180. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,rad,Time_start,dt_here,time_since_ae, & -!$OMP fluxes,i_off,j_off) & -!$OMP private(i,j,i2,j2,k,cosz_dt,fracday_dt,rrsun_dt, & -!$OMP fracday_day,cosz_day,rrsun_day,diurnal_factor) + !$OMP parallel do default(shared) private(i,j,i2,j2,cosz_dt,fracday_dt,rrsun_dt, & + !$OMP fracday_day,cosz_day,rrsun_day,diurnal_factor) do j=jsc,jec ; do i=isc,iec ! Per Rick Hemler: ! Call diurnal_solar with dtime=dt_here to get cosz averaged over dt_here. @@ -622,31 +631,32 @@ end subroutine offline_add_diurnal_sw !> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored !! in a previous integration of the online model -subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_file, surf_file, h_end, & - uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, ridx_sum, ridx_snap, read_mld, read_sw, & - read_ts_uvh, do_ale_in) +subroutine update_offline_from_files(G, GV, US, nk_input, mean_file, sum_file, snap_file, & + surf_file, h_end, uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, & + ridx_sum, ridx_snap, read_mld, read_sw, read_ts_uvh, do_ale_in) type(ocean_grid_type), intent(inout) :: G !< Horizontal grid type type(verticalGrid_type), intent(in ) :: GV !< Vertical grid type + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type integer, intent(in ) :: nk_input !< Number of levels in input file character(len=*), intent(in ) :: mean_file !< Name of file with averages fields 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(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_end !< End of timestep layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uhtr !< Zonal mass fluxes [kg] + intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or 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) :: h_end !< End of timestep layer thickness + intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: temp_mean !< Averaged temperature + intent(inout) :: temp_mean !< Averaged temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt_mean !< Averaged salinity + intent(inout) :: salt_mean !< Averaged salinity [ppt] real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: mld !< Averaged mixed layer depth + intent(inout) :: mld !< Averaged mixed layer depth [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(inout) :: Kd !< Diapycnal diffusivities at interfaces + intent(inout) :: Kd !< Diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files integer, intent(in ) :: ridx_snap !< Read index for snapshot file @@ -656,15 +666,22 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ logical, optional, intent(in ) :: do_ale_in !< True if using ALE algorithms logical :: do_ale + real :: convert_to_H ! A scale conversion factor from the thickness units in the + ! file to H [H m-1 or H m2 kg-1 ~> 1] integer :: i, j, k, is, ie, js, je, nz - real :: Initer_vert do_ale = .false. - if (present(do_ale_in) ) do_ale = do_ale_in + if (present(do_ale_in)) do_ale = do_ale_in is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! Check if reading in UH, VH, and h_end + if (GV%Boussinesq) then + convert_to_H = GV%m_to_H + else + convert_to_H = GV%kg_m2_to_H + endif + + ! Check if reading in temperature, salinity, transports and ending thickness if (read_ts_uvh) then h_end(:,:,:) = 0.0 temp_mean(:,:,:) = 0.0 @@ -674,9 +691,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! Time-summed fields call MOM_read_vector(sum_file, 'uhtr_sum', 'vhtr_sum', uhtr(:,:,1:nk_input), & vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum, & - scale=GV%kg_m2_to_H) + scale=US%m_to_L**2*GV%kg_m2_to_H) call MOM_read_data(snap_file, 'h_end', h_end(:,:,1:nk_input), G%Domain, & - timelevel=ridx_snap,position=CENTER) + timelevel=ridx_snap, position=CENTER, scale=convert_to_H) call MOM_read_data(mean_file, 'temp', temp_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) call MOM_read_data(mean_file, 'salt', salt_mean(:,:,1:nk_input), G%Domain, & @@ -693,7 +710,7 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! Check if reading vertical diffusivities or entrainment fluxes call MOM_read_data( mean_file, 'Kd_interface', Kd(:,:,1:nk_input+1), G%Domain, & - timelevel=ridx_sum,position=CENTER) + timelevel=ridx_sum, position=CENTER, scale=US%m2_s_to_Z2_T) ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine @@ -720,7 +737,7 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ endif if (read_mld) then - call MOM_read_data(surf_file, 'ePBL_h_ML', mld, G%Domain, timelevel=ridx_sum) + call MOM_read_data(surf_file, 'ePBL_h_ML', mld, G%Domain, timelevel=ridx_sum, scale=US%m_to_Z) endif if (read_sw) then @@ -729,9 +746,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! direct fluxes in the visible and near-infrared bands. For convenience, we store the ! sum of the direct and diffuse fluxes in the 'dir' field and set the 'dif' fields to zero call MOM_read_data(mean_file,'sw_vis', fluxes%sw_vis_dir, G%Domain, & - timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) + timelevel=ridx_sum, scale=US%W_m2_to_QRZ_T) call MOM_read_data(mean_file,'sw_nir', fluxes%sw_nir_dir, G%Domain, & - timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) + timelevel=ridx_sum, scale=US%W_m2_to_QRZ_T) fluxes%sw_vis_dir(:,:) = fluxes%sw_vis_dir(:,:)*0.5 fluxes%sw_vis_dif(:,:) = fluxes%sw_vis_dir(:,:) fluxes%sw_nir_dir(:,:) = fluxes%sw_nir_dir(:,:)*0.5 @@ -765,12 +782,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_(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(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hend !< End of timestep layer thickness + !! [H ~> m or kg m-2] + real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0a61ee1ba2..72041fbc86 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -63,12 +63,6 @@ module MOM_offline_main !< A pointer to the tracer registry type(thermo_var_ptrs), pointer :: tv => NULL() !< A structure pointing to various thermodynamic variables - 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 - type(unit_scale_type), pointer :: US => NULL() - !< structure containing various unit conversion factors type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() @@ -125,7 +119,8 @@ module MOM_offline_main !! This is copied from diabatic_CS controlling how tracers follow freshwater fluxes real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity - real :: min_residual !< The minimum amount of total mass flux before exiting the main advection routine + real :: min_residual !< The minimum amount of total mass flux before exiting the main advection + !! routine [H L2 ~> m3 or kg] !>@{ Diagnostic manager IDs for some fields that may be of interest when doing offline transport integer :: & id_uhr = -1, & @@ -158,9 +153,9 @@ module MOM_offline_main integer :: id_clock_offline_adv = -1 !< A CPU time clock integer :: id_clock_redistribute = -1 !< A CPU time clock - !> Zonal transport that may need to be stored between calls to step_MOM + !> Zonal transport that may need to be stored between calls to step_MOM [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:) :: uhtr - !> Meridional transport that may need to be stored between calls to step_MOM + !> Meridional transport that may need to be stored between calls to step_MOM [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:) :: vhtr ! Fields at T-point @@ -171,19 +166,19 @@ module MOM_offline_main !< Amount of fluid entrained from the layer below within !! one time step [H ~> m or kg m-2] ! Fields at T-points on interfaces - real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity - real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep + real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep [H ~> m or kg m-2] real, allocatable, dimension(:,:) :: netMassIn !< Freshwater fluxes into the ocean real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean - real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m]. + real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m] ! Allocatable arrays to read in entire fields during initialization - real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport - real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of mericional transport - real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses - real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures - real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities + real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport [H L2 ~> m3 or kg] + real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of meridional transport [H L2 ~> m3 or kg] + real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures [degC] + real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities [ppt] end type offline_transport_CS @@ -206,41 +201,37 @@ module MOM_offline_main !> 3D advection is done by doing flux-limited nonlinear horizontal advection interspersed with an ALE !! regridding/remapping step. The loop in this routine is exited if remaining residual transports are below !! a runtime-specified value or a maximum number of iterations is reached. -subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ale, h_pre, uhtr, vhtr, converged) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval - 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%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%GV)), & - intent(inout) :: uhtr !< Zonal mass transport [H m2 ~> m3 or kg] - 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 - - ! 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 - ! Work arrays for mass transports - 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%GV)) :: vhtr_sub - - real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are +subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS, id_clock_ale, & + h_pre, uhtr, vhtr, converged) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< time interval covered by this call [s] + 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 + type(offline_transport_CS), pointer :: CS !< control structure for offline module + integer, intent(in) :: id_clock_ALE !< Clock for ALE routines + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection + !! [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] + logical, intent( out) :: converged !< True if the iterations have converged + + ! Local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhtr_sub ! Substep zonal mass transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub ! Substep meridional mass transports [H L2 ~> m3 or kg] + + real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are [H L2 ~> m3 or kg] ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - h_new, & - h_vol - ! Fields for eta_diff diagnostic - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end - integer :: niter, iter - real :: Inum_iter + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! Updated layer thicknesses [H ~> m or kg m-2] + h_vol ! Layer volumes [H L2 ~> m3 or kg] + integer :: niter, iter + real :: Inum_iter ! The inverse of the number of iterations [nondim] character(len=256) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. @@ -250,15 +241,11 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! top layer in a timestep [nondim] real :: minimum_forcing_depth ! The smallest depth over which fluxes can be applied [H ~> m or kg m-2] real :: dt_iter ! The timestep to use for each iteration [T ~> s] - - integer :: nstocks - real :: stock_values(MAX_FIELDS_) + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] character(len=20) :: debug_msg call cpu_clock_begin(CS%id_clock_offline_adv) ! Grid-related pointer assignments - G => CS%G - GV => CS%GV x_before_y = CS%x_before_y @@ -270,6 +257,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock evap_CFL_limit = CS%evap_CFL_limit minimum_forcing_depth = CS%minimum_forcing_depth + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 niter = CS%num_off_iter Inum_iter = 1./real(niter) dt_iter = CS%dt_offline*Inum_iter @@ -314,12 +302,12 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock enddo ; enddo ; enddo if (CS%debug) then - call hchksum(h_pre,"h_pre before transport",G%HI) - call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI) + call hchksum(h_pre, "h_pre before transport", G%HI, scale=GV%H_to_m) + call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) endif - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif @@ -328,18 +316,18 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock do iter=1,CS%num_off_iter do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_new(i,j,k) * G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_new(i,j,k) * G%areaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo if (CS%debug) then - call hchksum(h_vol,"h_vol before advect",G%HI) - call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI) + call hchksum(h_vol, "h_vol before advect", G%HI, scale=HL2_to_kg_scale) + call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) write(debug_msg, '(A,I4.4)') 'Before advect ', iter 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, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) @@ -348,14 +336,14 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) !### Replace with "* G%IareaT(i,j)" enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then ! Do ALE remapping/regridding to allow for more advection to occur in the next iteration call pass_var(h_new,G%Domain) if (CS%debug) then - call hchksum(h_new,"h_new before ALE",G%HI) + call hchksum(h_new,"h_new before ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'Before ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -364,7 +352,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call cpu_clock_end(id_clock_ALE) if (CS%debug) then - call hchksum(h_new,"h_new after ALE",G%HI) + call hchksum(h_new, "h_new after ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'After ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -375,13 +363,13 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo call pass_var(h_new, G%Domain) - call pass_vector(uhtr_sub,vhtr_sub,G%Domain) + call pass_vector(uhtr_sub, vhtr_sub, G%Domain) ! Check for whether we've used up all the advection, or if we need to move on because ! advection has stalled - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif ! If all the mass transports have been used u, then quit @@ -403,11 +391,11 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Make sure that uhtr and vhtr halos are updated h_pre(:,:,:) = h_new(:,:,:) - call pass_vector(uhtr,vhtr,G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) 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 hchksum(h_pre, "h after offline_advection_ale", G%HI, scale=GV%H_to_m) + call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("After offline_advection_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -419,53 +407,49 @@ end subroutine offline_advection_ale !! transport. Two different ways are offered, 'barotropic' means that the residual is distributed equally !! throughout the water column. 'upwards' attempts to redistribute the transport in the layers above and will !! eventually work down the entire water column -subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) +subroutine offline_redistribute_residual(CS, G, GV, US, 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%GV)), & - intent(inout) :: h_pre !< layer thicknesses before advection - 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 + 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_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] logical, intent(in ) :: converged !< True if the iterations have converged - 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 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%GV)) :: & - h_new, & - h_vol + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! New layer thicknesses [H ~> m or kg m-2] + h_vol ! Cell volume [H L2 ~> m3 or kg] ! 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%GV)) :: uhr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhr !< Meridional mass transport + real, dimension(SZI_(G),SZJ_(G)) :: eta_work ! The total column thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhr !< Remaining meridional mass transport [H L2 ~> m3 or kg] 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 - real :: prev_tot_residual, tot_residual, stock_values(MAX_FIELDS_) - integer :: nstocks - - ! Assign grid pointers - G => CS%G - GV => CS%GV + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] + real :: prev_tot_residual, tot_residual ! The absolute value of the remaining transports [H L2 ~> m3 or kg] 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 x_before_y = CS%x_before_y + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 if (CS%id_eta_pre_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom_H) then + if (h_pre(i,j,k) > GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo - call post_data(CS%id_eta_pre_distribute,eta_work,CS%diag) + call post_data(CS%id_eta_pre_distribute, eta_work, CS%diag) endif ! These are used to find out how much will be redistributed in this routine @@ -489,17 +473,17 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) ! Store volumes for advect_tracer h_pre(:,:,:) = h_vol(:,:,:) if (CS%debug) then call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) - call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif if (x_before_y) then @@ -510,9 +494,9 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & - h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & + h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) if (CS%debug) then call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -522,8 +506,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -534,17 +517,17 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call pass_var(h_vol,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) + call pass_var(h_vol, G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) ! Copy h_vol to h_pre for advect_tracer routine h_pre(:,:,:) = h_vol(:,:,:) if (CS%debug) then call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) - call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif if (x_before_y) then @@ -555,9 +538,9 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & - h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & + h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) if (CS%debug) then call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -567,17 +550,16 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! redistribute barotropic ! Check to see if all transport has been exhausted - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif ! If the remaining residual is 0, then this return is done @@ -598,15 +580,15 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo - call post_data(CS%id_eta_post_distribute,eta_work,CS%diag) + call post_data(CS%id_eta_post_distribute, eta_work, CS%diag) endif - if (CS%id_uhr>0) call post_data(CS%id_uhr,uhtr,CS%diag) - if (CS%id_vhr>0) call post_data(CS%id_vhr,vhtr,CS%diag) + if (CS%id_uhr>0) call post_data(CS%id_uhr, uhtr, CS%diag) + if (CS%id_vhr>0) call post_data(CS%id_vhr, vhtr, CS%diag) if (CS%debug) then - call hchksum(h_pre,"h_pre after redistribute",G%HI) - call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI) + call hchksum(h_pre, "h_pre after redistribute", G%HI, scale=GV%H_to_m) + call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("after redistribute ", G, GV, h_new, CS%tracer_Reg%Tr, CS%tracer_Reg%ntr) endif @@ -614,11 +596,14 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) 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%GV)), intent(in ) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(in ) :: vhtr !< Meridional mass transport +!> Returns the sums of any non-negligible remaining transport [H L2 ~> m3 or kg] to check for advection convergence +real function remaining_transport_sum(G, GV, uhtr, vhtr) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(in ) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in ) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] ! Local variables integer :: i, j, k @@ -627,15 +612,15 @@ real function remaining_transport_sum(CS, uhtr, vhtr) real :: uh_neglect !< A small value of zonal transport that effectively is below roundoff error real :: vh_neglect !< A small value of meridional transport that effectively is below roundoff error - nz = CS%GV%ke - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - h_min = CS%GV%H_subroundoff + h_min = GV%H_subroundoff remaining_transport_sum = 0. 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)) + uh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i+1,j)) + vh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i,j+1)) if (ABS(uhtr(I,j,k))>uh_neglect) then remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) endif @@ -643,6 +628,7 @@ real function remaining_transport_sum(CS, uhtr, vhtr) remaining_transport_sum = remaining_transport_sum + ABS(vhtr(i,J,k)) endif enddo ; enddo ; enddo + !### The value of this sum is not layout independent. call sum_across_PEs(remaining_transport_sum) end function remaining_transport_sum @@ -650,40 +636,40 @@ end function remaining_transport_sum !> The vertical/diabatic driver for offline tracers. First the eatr/ebtr associated with the interpolated !! vertical diffusivities are calculated and then any tracer column functions are done which can include !! vertical diffuvities and source/sink terms. -subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, ebtr) - - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - 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%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%GV)), & - intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] - 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)) :: & +subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_pre, eatr, ebtr) + + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + type(time_type), intent(in) :: Time_end !< ending time of a segment, as a time type + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] + + real, dimension(SZI_(G),SZJ_(G)) :: & sw, sw_vis, sw_nir !< Save old values of shortwave radiation [Q R Z T-1 ~> W m-2] - real :: hval - integer :: i,j,k - integer :: is, ie, js, je, nz + real :: I_hval ! An inverse thickness [H-1 ~> m2 kg-1] + integer :: i, j, k, is, ie, js, je, nz integer :: k_nonzero - real :: stock_values(MAX_FIELDS_) - real :: Kd_bot - integer :: nstocks - nz = CS%GV%ke - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + real :: Kd_bot ! Near-bottom diffusivity [Z2 T-1 ~> m2 s-1] + nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec call cpu_clock_begin(CS%id_clock_offline_diabatic) call MOM_mesg("Applying tracer source, sinks, and vertical mixing") if (CS%debug) then - 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, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h_pre, "h_pre before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(eatr, "eatr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "ebtr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call MOM_tracer_chkinv("Before offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif eatr(:,:,:) = 0. @@ -712,8 +698,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e eatr(i,j,1) = 0. enddo ; enddo do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(CS%GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k))) - eatr(i,j,k) = (CS%GV%m_to_H**2*CS%US%T_to_s) * CS%dt_offline_vertical * hval * CS%Kd(i,j,k) + I_hval = 1.0 / (GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k))) + eatr(i,j,k) = GV%Z_to_H**2 * CS%dt_offline_vertical * I_hval * CS%Kd(i,j,k) ebtr(i,j,k-1) = eatr(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -725,17 +711,17 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e sw(:,:) = fluxes%sw(:,:) sw_vis(:,:) = fluxes%sw_vis_dir(:,:) sw_nir(:,:) = fluxes%sw_nir_dir(:,:) - call offline_add_diurnal_SW(fluxes, CS%G, Time_start, Time_end) + call offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) endif if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%US, CS%diabatic_aux_CSp, & + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, & CS%opacity_CSp, CS%tracer_flow_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for call call_tracer_column_fns(h_pre, h_pre, eatr, ebtr, fluxes, CS%MLD, CS%dt_offline_vertical, & - CS%G, CS%GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) if (CS%diurnal_SW .and. CS%read_sw) then fluxes%sw(:,:) = sw(:,:) @@ -744,10 +730,10 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (CS%debug) then - 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, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h_pre, "h_pre after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(eatr, "eatr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "ebtr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call MOM_tracer_chkinv("After offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call cpu_clock_end(CS%id_clock_offline_diabatic) @@ -768,7 +754,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) !! of tracer that leaves with freshwater integer :: i, j, m - real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes + real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes [H ~> m or kg m-2] logical :: update_h !< Flag for whether h should be updated if ( present(in_flux_optional) ) & @@ -786,17 +772,17 @@ 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 hchksum(h, "h before fluxes into ocean", G%HI, scale=GV%H_to_m) 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 update_h = ( m == CS%tracer_reg%ntr ) call applyTracerBoundaryFluxesInOut(G, GV, CS%tracer_reg%tr(m)%t, CS%dt_offline, fluxes, h, & - CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) + 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 hchksum(h, "h after fluxes into ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("After fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -824,7 +810,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) call MOM_error(WARNING, "Negative freshwater fluxes with non-zero tracer concentration not supported yet") if (CS%debug) then - call hchksum(h,"h before fluxes out of ocean",G%HI) + call hchksum(h, "h before fluxes out of ocean", G%HI, scale=GV%H_to_m) 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 @@ -834,7 +820,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) enddo if (CS%debug) then - call hchksum(h,"h after fluxes out of ocean",G%HI) + call hchksum(h, "h after fluxes out of ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -842,46 +828,48 @@ end subroutine offline_fw_fluxes_out_ocean !> When in layer mode, 3D horizontal advection using stored mass fluxes must be used. Horizontal advection is !! done via tracer_advect, whereas the vertical component is actually handled by vertdiff in tracer_column_fns -subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, eatr, ebtr, uhtr, vhtr) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< Offline transport time interval - type(offline_transport_CS), pointer :: CS !< Control structure for offline module - 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%GV)) :: uhtr_sub - ! Remaining meridional mass transports - 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 +subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS, h_pre, eatr, ebtr, uhtr, vhtr) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< Offline transport time interval [s] + 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 + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] ! Local variables - ! Vertical diffusion related variables - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & + + ! Remaining zonal mass transports [H L2 ~> m3 or kg] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhtr_sub + ! Remaining meridional mass transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub + + real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are [H L2 ~> m3 or kg] + ! Vertical diffusion related variables [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(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%GV)) :: & - h_new, & - h_vol + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! Updated thicknesses [H ~> m or kg m-2] + h_vol ! Cell volumes [H L2 ~> m3 or kg] ! Work arrays for temperature and salinity - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - temp_old, salt_old, & - temp_mean, salt_mean, & - zero_3dh ! + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + temp_old, temp_mean, & ! Temperatures [degC] + salt_old, salt_mean ! Salinities [ppt] integer :: niter, iter - real :: Inum_iter real :: dt_iter ! The timestep of each iteration [T ~> s] + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] logical :: converged character(len=160) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz @@ -889,26 +877,25 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, integer :: IsdB, IedB, JsdB, JedB logical :: z_first, x_before_y - G => CS%G ; GV => CS%GV 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 - dt_iter = CS%US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) + dt_iter = US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) x_before_y = CS%x_before_y do iter=1,CS%num_off_iter - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr_sub(i,j,k) = eatr(i,j,k) ebtr_sub(i,j,k) = ebtr(i,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr_sub(I,j,k) = uhtr(I,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo @@ -920,23 +907,23 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First do vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, CS%mld, dt_iter, G, GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + fluxes, CS%mld, dt_iter, G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo call pass_var(h_pre,G%Domain) ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -946,39 +933,39 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo ! Second vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, CS%mld, dt_iter, G, GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + fluxes, CS%mld, dt_iter, G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! Update remaining transports - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo ; enddo ; enddo @@ -999,7 +986,10 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, enddo ; enddo ; enddo call sum_across_PEs(sum_abs_fluxes) - write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", sum_u, sum_v + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 + + write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", & + sum_u*HL2_to_kg_scale, sum_v*HL2_to_kg_scale call MOM_mesg(mesg) if (sum_abs_fluxes==0) then write(mesg,*) 'offline_advection_layer: Converged after iteration', iter @@ -1016,42 +1006,59 @@ end subroutine offline_advection_layer !> Update fields used in this round of offline transport. First fields are updated from files or from arrays !! 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%GV)) :: h !< The regridded layer thicknesses - type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields - logical, intent(in ) :: do_ale !< True if using ALE +subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + 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 !< The regridded layer thicknesses [H ~> m or kg m-2] + 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%GV)) :: h_start - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec ; nz = CS%GV%ke + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_start ! Initial thicknesses [H ~> m or kg m-2] + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call cpu_clock_begin(CS%id_clock_read_fields) call callTree_enter("update_offline_fields, MOM_offline_main.F90") + if (CS%debug) then + call uvchksum("[uv]htr before update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%h_end, "h_end before update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%tv%T, "Temp before update_offline_fields", G%HI) + call hchksum(CS%tv%S, "Salt before update_offline_fields", G%HI) + endif + ! Store a copy of the layer thicknesses before ALE regrid/remap h_start(:,:,:) = h(:,:,:) ! Most fields will be read in from files - call update_offline_from_files( CS%G, CS%GV, CS%nk_input, CS%mean_file, CS%sum_file, CS%snap_file, CS%surf_file, & - CS%h_end, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S, CS%mld, CS%Kd, fluxes, & - CS%ridx_sum, CS%ridx_snap, CS%read_mld, CS%read_sw, .not. CS%read_all_ts_uvh, do_ale) + call update_offline_from_files( G, GV, US, CS%nk_input, CS%mean_file, CS%sum_file, CS%snap_file, & + CS%surf_file, CS%h_end, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S, & + CS%mld, CS%Kd, fluxes, CS%ridx_sum, CS%ridx_snap, CS%read_mld, & + CS%read_sw, .not.CS%read_all_ts_uvh, do_ale) ! If uh, vh, h_end, temp, salt were read in at the beginning, fields are copied from those arrays if (CS%read_all_ts_uvh) then - call update_offline_from_arrays(CS%G, CS%GV, CS%nk_input, CS%ridx_sum, CS%mean_file, CS%sum_file, CS%snap_file, & - CS%uhtr, CS%vhtr, CS%h_end, CS%uhtr_all, CS%vhtr_all, CS%hend_all, CS%tv%T, CS%tv%S, CS%temp_all, CS%salt_all) - endif + call update_offline_from_arrays(G, GV, CS%nk_input, CS%ridx_sum, CS%mean_file, CS%sum_file, & + CS%snap_file, CS%uhtr, CS%vhtr, CS%h_end, CS%uhtr_all, CS%vhtr_all, & + CS%hend_all, CS%tv%T, CS%tv%S, CS%temp_all, CS%salt_all) + endif if (CS%debug) then - call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, CS%G%HI) + call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%tv%T, "Temp after update offline from files and arrays", G%HI) + call hchksum(CS%tv%S, "Salt after update offline from files and arrays", G%HI) endif ! If using an ALE-dependent vertical coordinate, fields will need to be remapped if (do_ale) then ! These halo passes are necessary because u, v fields will need information 1 step into the halo - call pass_var(h, CS%G%Domain) - call pass_var(CS%tv%T, CS%G%Domain) - call pass_var(CS%tv%S, CS%G%Domain) - call ALE_offline_inputs(CS%ALE_CSp, CS%G, CS%GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, & + call pass_var(h, G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) + call ALE_offline_inputs(CS%ALE_CSp, G, GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, & CS%debug, CS%OBC) if (CS%id_temp_regrid>0) call post_data(CS%id_temp_regrid, CS%tv%T, CS%diag) if (CS%id_salt_regrid>0) call post_data(CS%id_salt_regrid, CS%tv%S, CS%diag) @@ -1059,15 +1066,16 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) if (CS%id_vhtr_regrid>0) call post_data(CS%id_vhtr_regrid, CS%vhtr, CS%diag) if (CS%id_h_regrid>0) call post_data(CS%id_h_regrid, h, CS%diag) if (CS%debug) then - call uvchksum("[uv]h after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, CS%G%HI) - call hchksum(h_start,"h_start after update offline from files and arrays", CS%G%HI) + call uvchksum("[uv]htr after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(h_start,"h_start after ALE regridding/remapping of inputs", G%HI, scale=GV%H_to_m) endif endif ! Update halos for some - call pass_var(CS%h_end, CS%G%Domain) - call pass_var(CS%tv%T, CS%G%Domain) - call pass_var(CS%tv%S, CS%G%Domain) + call pass_var(CS%h_end, G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) @@ -1075,8 +1083,8 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) ! Apply masks/factors at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie - if (CS%G%mask2dT(i,j)<1.0) then - CS%h_end(i,j,k) = CS%GV%Angstrom_H + if (G%mask2dT(i,j)<1.0) then + CS%h_end(i,j,k) = GV%Angstrom_H endif enddo ; enddo ; enddo @@ -1088,22 +1096,23 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) enddo ; enddo ; enddo do k=1,nz ; do J=js-1,je ; do i=is,ie - if (CS%G%mask2dCv(i,J)<1.0) then + if (G%mask2dCv(i,J)<1.0) then CS%vhtr(i,J,k) = 0.0 endif enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie - if (CS%G%mask2dCu(I,j)<1.0) then + if (G%mask2dCu(I,j)<1.0) then CS%uhtr(I,j,k) = 0.0 endif enddo ; enddo ; enddo if (CS%debug) then - call uvchksum("[uv]htr_sub after update_offline_fields", CS%uhtr, CS%vhtr, CS%G%HI) - call hchksum(CS%h_end, "h_end after update_offline_fields", CS%G%HI) - call hchksum(CS%tv%T, "Temp after update_offline_fields", CS%G%HI) - call hchksum(CS%tv%S, "Salt after update_offline_fields", CS%G%HI) + call uvchksum("[uv]htr after update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%h_end, "h_end after update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%tv%T, "Temp after update_offline_fields", G%HI) + call hchksum(CS%tv%S, "Salt after update_offline_fields", G%HI) endif call callTree_leave("update_offline_fields") @@ -1112,80 +1121,100 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) end subroutine update_offline_fields !> Initialize additional diagnostics required for offline tracer transport -subroutine register_diags_offline_transport(Time, diag, CS) +subroutine register_diags_offline_transport(Time, diag, CS, GV, US) type(offline_transport_CS), pointer :: CS !< Control structure for offline module + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Time !< current model time type(diag_ctrl), intent(in) :: diag !< Structure that regulates diagnostic output ! U-cell fields CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & - 'Zonal thickness fluxes remaining at end of advection', 'kg') + 'Zonal thickness fluxes remaining at end of advection', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_uhr_redist = register_diag_field('ocean_model', 'uhr_redist', diag%axesCuL, Time, & - 'Zonal thickness fluxes to be redistributed vertically', 'kg') + 'Zonal thickness fluxes to be redistributed vertically', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_uhr_end = register_diag_field('ocean_model', 'uhr_end', diag%axesCuL, Time, & - 'Zonal thickness fluxes at end of offline step', 'kg') + 'Zonal thickness fluxes at end of offline step', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) ! V-cell fields CS%id_vhr = register_diag_field('ocean_model', 'vhr', diag%axesCvL, Time, & - 'Meridional thickness fluxes remaining at end of advection', 'kg') + 'Meridional thickness fluxes remaining at end of advection', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhr_redist = register_diag_field('ocean_model', 'vhr_redist', diag%axesCvL, Time, & - 'Meridional thickness to be redistributed vertically', 'kg') + 'Meridional thickness to be redistributed vertically', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhr_end = register_diag_field('ocean_model', 'vhr_end', diag%axesCvL, Time, & - 'Meridional thickness at end of offline step', 'kg') + 'Meridional thickness at end of offline step', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) ! T-cell fields CS%id_hdiff = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & - 'Difference between the stored and calculated layer thickness', 'm') + 'Difference between the stored and calculated layer thickness', & + 'm', conversion=GV%H_to_m) CS%id_hr = register_diag_field('ocean_model', 'hr', diag%axesTL, Time, & - 'Layer thickness at end of offline step', 'm') + 'Layer thickness at end of offline step', 'm', conversion=GV%H_to_m) CS%id_ear = register_diag_field('ocean_model', 'ear', diag%axesTL, Time, & 'Remaining thickness entrained from above', 'm') CS%id_ebr = register_diag_field('ocean_model', 'ebr', diag%axesTL, Time, & 'Remaining thickness entrained from below', 'm') CS%id_eta_pre_distribute = register_diag_field('ocean_model','eta_pre_distribute', & - diag%axesT1, Time, 'Total water column height before residual transport redistribution','m') + diag%axesT1, Time, 'Total water column height before residual transport redistribution', & + 'm', conversion=GV%H_to_m) CS%id_eta_post_distribute = register_diag_field('ocean_model','eta_post_distribute', & - diag%axesT1, Time, 'Total water column height after residual transport redistribution','m') + diag%axesT1, Time, 'Total water column height after residual transport redistribution', & + 'm', conversion=GV%H_to_m) CS%id_eta_diff_end = register_diag_field('ocean_model','eta_diff_end', diag%axesT1, Time, & 'Difference in total water column height from online and offline ' // & - 'at the end of the offline timestep','m') + 'at the end of the offline timestep', 'm', conversion=GV%H_to_m) CS%id_h_redist = register_diag_field('ocean_model','h_redist', diag%axesTL, Time, & - 'Layer thicknesses before redistribution of mass fluxes','m') + 'Layer thicknesses before redistribution of mass fluxes', & + 'm', conversion=GV%H_to_m) ! Regridded/remapped input fields CS%id_uhtr_regrid = register_diag_field('ocean_model', 'uhtr_regrid', diag%axesCuL, Time, & - 'Zonal mass transport regridded/remapped onto offline grid','kg') + 'Zonal mass transport regridded/remapped onto offline grid', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhtr_regrid = register_diag_field('ocean_model', 'vhtr_regrid', diag%axesCvL, Time, & - 'Meridional mass transport regridded/remapped onto offline grid','kg') + 'Meridional mass transport regridded/remapped onto offline grid', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_temp_regrid = register_diag_field('ocean_model', 'temp_regrid', diag%axesTL, Time, & 'Temperature regridded/remapped onto offline grid','C') CS%id_salt_regrid = register_diag_field('ocean_model', 'salt_regrid', diag%axesTL, Time, & 'Salinity regridded/remapped onto offline grid','g kg-1') CS%id_h_regrid = register_diag_field('ocean_model', 'h_regrid', diag%axesTL, Time, & - 'Layer thicknesses regridded/remapped onto offline grid','m') - + 'Layer thicknesses regridded/remapped onto offline grid', & + 'm', conversion=GV%H_to_m) 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) +subroutine post_offline_convergence_diags(G, GV, CS, h_off, h_end, uhtr, vhtr) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(offline_transport_CS), intent(in ) :: CS !< Offline control structure - 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_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_off !< Thicknesses at end of offline step [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_end !< Stored thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Remaining meridional mass transport [H L2 ~> m3 or kg] - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff + real, dimension(SZI_(G),SZJ_(G)) :: eta_diff ! Differences in column thickness [H ~> m or kg m-2] integer :: i, j, k if (CS%id_eta_diff_end>0) then ! Calculate difference in column thickness eta_diff = 0. - do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec eta_diff(i,j) = eta_diff(i,j) + h_off(i,j,k) enddo ; enddo ; enddo - do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec eta_diff(i,j) = eta_diff(i,j) - h_end(i,j,k) enddo ; enddo ; enddo @@ -1205,8 +1234,8 @@ subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_t dt_offline, dt_offline_vertical, skip_diffusion) type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure ! Returned optional arguments - real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport [H m2 ~> m3 or kg] - real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport [H m2 ~> m3 or kg] + real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport [H L2 ~> m3 or kg] real, dimension(:,:,:), optional, pointer :: eatr !< Amount of fluid entrained from the layer above within !! one time step [H ~> m or kg m-2] real, dimension(:,:,:), optional, pointer :: ebtr !< Amount of fluid entrained from the layer below within @@ -1243,7 +1272,7 @@ end subroutine extract_offline_main !> Inserts (assigns values to) members of the offline main control structure. All arguments !! are optional except for the CS itself subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, & - tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug) + tracer_flow_CSp, tracer_Reg, tv, x_before_y, debug) type(offline_transport_CS), intent(inout) :: CS !< Offline control structure ! Inserted optional arguments type(ALE_CS), & @@ -1262,10 +1291,6 @@ subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_ target, optional, intent(in ) :: tracer_Reg !< A pointer to the tracer registry type(thermo_var_ptrs), & target, optional, intent(in ) :: tv !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), & - target, optional, intent(in ) :: G !< ocean grid structure - type(verticalGrid_type), & - target, optional, intent(in ) :: GV !< ocean vertical grid structure logical, optional, intent(in ) :: x_before_y !< Indicates which horizontal direction is advected first logical, optional, intent(in ) :: debug !< If true, write verbose debugging messages @@ -1278,8 +1303,6 @@ subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_ if (present(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp if (present(tracer_Reg)) CS%tracer_Reg => tracer_Reg if (present(tv)) CS%tv => tv - if (present(G)) CS%G => G - if (present(GV)) CS%GV => GV if (present(x_before_y)) CS%x_before_y = x_before_y if (present(debug)) CS%debug = debug @@ -1309,37 +1332,33 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) call callTree_enter("offline_transport_init, MOM_offline_control.F90") if (associated(CS)) then - call MOM_error(WARNING, "offline_transport_init called with an associated "// & - "control structure.") + call MOM_error(WARNING, "offline_transport_init called with an associated control structure.") return endif allocate(CS) call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") - ! Determining the internal unit scaling factors for this run. - CS%US => US - ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & - "Input directory where the offline fields can be found", fail_if_missing = .true.) + "Input directory where the offline fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SUM_FILE", CS%sum_file, & - "Filename where the accumulated fields can be found", fail_if_missing = .true.) + "Filename where the accumulated fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SNAP_FILE", CS%snap_file, & - "Filename where snapshot fields can be found", fail_if_missing = .true.) + "Filename where snapshot fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_MEAN_FILE", CS%mean_file, & - "Filename where averaged fields can be found", fail_if_missing = .true.) + "Filename where averaged fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SURF_FILE", CS%surf_file, & - "Filename where averaged fields can be found", fail_if_missing = .true.) + "Filename where averaged fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "NUMTIME", CS%numtime, & - "Number of timelevels in offline input files", fail_if_missing = .true.) + "Number of timelevels in offline input files", fail_if_missing=.true.) call get_param(param_file, mdl, "NK_INPUT", CS%nk_input, & - "Number of vertical levels in offline input files", default = nz) + "Number of vertical levels in offline input files", default=nz) call get_param(param_file, mdl, "DT_OFFLINE", CS%dt_offline, & - "Length of time between reading in of input fields", units='s', scale=US%s_to_T, fail_if_missing = .true.) + "Length of time between reading in of input fields", units='s', scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_OFFLINE_VERTICAL", CS%dt_offline_vertical, & "Length of the offline timestep for tracer column sources/sinks " //& "This should be set to the length of the coupling timestep for " //& - "tracers which need shortwave fluxes", units="s", scale=US%s_to_T, fail_if_missing = .true.) + "tracers which need shortwave fluxes", units="s", scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "START_INDEX", CS%start_index, & "Which time index to start from", default=1) call get_param(param_file, mdl, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & @@ -1355,42 +1374,40 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) default='barotropic') call get_param(param_file, mdl, "NUM_OFF_ITER", CS%num_off_iter, & "Number of iterations to subdivide the offline tracer advection and diffusion", & - default = 60) + default=60) call get_param(param_file, mdl, "OFF_ALE_MOD", CS%off_ale_mod, & - "Sets how many horizontal advection steps are taken before an ALE " //& - "remapping step is done. 1 would be x->y->ALE, 2 would be" //& - "x->y->x->y->ALE", default = 1) + "Sets how many horizontal advection steps are taken before an ALE "//& + "remapping step is done. 1 would be x->y->ALE, 2 would be x->y->x->y->ALE", default=1) call get_param(param_file, mdl, "PRINT_ADV_OFFLINE", CS%print_adv_offline, & - "Print diagnostic output every advection subiteration",default=.false.) + "Print diagnostic output every advection subiteration", default=.false.) call get_param(param_file, mdl, "SKIP_DIFFUSION_OFFLINE", CS%skip_diffusion, & - "Do not do horizontal diffusion",default=.false.) + "Do not do horizontal diffusion", default=.false.) call get_param(param_file, mdl, "READ_SW", CS%read_sw, & - "Read in shortwave radiation field instead of using values from the coupler"//& - "when in offline tracer mode",default=.false.) + "Read in shortwave radiation field instead of using values from the coupler "//& + "when in offline tracer mode", default=.false.) call get_param(param_file, mdl, "READ_MLD", CS%read_mld, & - "Read in mixed layer depths for tracers which exchange with the atmosphere"//& - "when in offline tracer mode",default=.false.) + "Read in mixed layer depths for tracers which exchange with the atmosphere "//& + "when in offline tracer mode", default=.false.) call get_param(param_file, mdl, "MLD_VAR_NAME", CS%mld_var_name, & - "Name of the variable containing the depth of active mixing",& - default='ePBL_h_ML') + "Name of the variable containing the depth of active mixing", default='ePBL_h_ML') call get_param(param_file, mdl, "OFFLINE_ADD_DIURNAL_SW", CS%diurnal_sw, & - "Adds a synthetic diurnal cycle in the same way that the ice " // & - "model would have when time-averaged fields of shortwave " // & + "Adds a synthetic diurnal cycle in the same way that the ice "//& + "model would have when time-averaged fields of shortwave "//& "radiation are read in", default=.false.) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal "//& "diffusivity from TKE-based parameterizations, or a "//& - "negative value for no limit.", units="m2 s-1", default=-1.0) + "negative value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "MIN_RESIDUAL_TRANSPORT", CS%min_residual, & - "How much remaining transport before the main offline advection "// & - "is exited. The default value corresponds to about 1 meter of " // & - "difference in a grid cell", default = 1.e9) + "How much remaining transport before the main offline advection is exited. "//& + "The default value corresponds to about 1 meter of difference in a grid cell", & + default=1.e9, units="m3", scale=GV%m_to_H*US%m_to_L**2) call get_param(param_file, mdl, "READ_ALL_TS_UVH", CS%read_all_ts_uvh, & "Reads all time levels of a subset of the fields necessary to run " // & "the model offline. This can require a large amount of memory "// & "and will make initialization very slow. However, for offline "// & "runs spanning more than a year this can reduce total I/O overhead", & - default = .false.) + default=.false.) ! Concatenate offline directory and file names CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) @@ -1398,7 +1415,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) CS%surf_file = trim(CS%offlinedir)//trim(CS%surf_file) - CS%num_vert_iter = CS%dt_offline/CS%dt_offline_vertical + CS%num_vert_iter = CS%dt_offline / CS%dt_offline_vertical ! Map redistribute_method onto logicals in CS select case (redistribute_method) @@ -1430,10 +1447,6 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) - ! Grid pointer assignments - CS%G => G - CS%GV => GV - ! Allocate arrays allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz), source=0.0) allocate(CS%vhtr(isd:ied,JsdB:JedB,nz), source=0.0) @@ -1446,7 +1459,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) if (CS%read_mld) allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed), source=0.0) if (CS%read_all_ts_uvh) then - call read_all_input(CS) + call read_all_input(CS, G, GV, US) endif ! Initialize ids for clocks used in offline routines @@ -1461,15 +1474,18 @@ end subroutine offline_transport_init !> Coordinates the allocation and reading in all time levels of uh, vh, hend, temp, and salt from files. Used !! when read_all_ts_uvh -subroutine read_all_input(CS) - type(offline_transport_CS), intent(inout) :: CS !< Control structure for offline module +subroutine read_all_input(CS, G, GV, US) + type(offline_transport_CS), intent(inout) :: CS !< Control structure for offline module + 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 integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime integer :: IsdB, IedB, JsdB, JedB - nz = CS%GV%ke ; ntime = CS%numtime - isd = CS%G%isd ; ied = CS%G%ied ; jsd = CS%G%jsd ; jed = CS%G%jed - IsdB = CS%G%IsdB ; IedB = CS%G%IedB ; JsdB = CS%G%JsdB ; JedB = CS%G%JedB + nz = GV%ke ; ntime = CS%numtime + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! Extra safety check that we're not going to overallocate any arrays if (CS%read_all_ts_uvh) then @@ -1488,13 +1504,14 @@ subroutine read_all_input(CS) call MOM_mesg("Reading in uhtr, vhtr, h_start, h_end, temp, salt") do t = 1,ntime call MOM_read_vector(CS%snap_file, 'uhtr_sum', 'vhtr_sum', CS%uhtr_all(:,:,1:CS%nk_input,t), & - CS%vhtr_all(:,:,1:CS%nk_input,t), CS%G%Domain, timelevel=t) - call MOM_read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) - call MOM_read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) - call MOM_read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) + CS%vhtr_all(:,:,1:CS%nk_input,t), G%Domain, timelevel=t, & + scale=US%m_to_L**2*GV%kg_m2_to_H) + call MOM_read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER, scale=GV%kg_m2_to_H) + call MOM_read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER) + call MOM_read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER) enddo endif From 112ac4998c806077b3b1d2f7d3eab54d322347a5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Dec 2021 06:07:47 -0500 Subject: [PATCH 106/138] +(*)Revised offline tracer algorithms Minorly revised the algorithms used for offline tracer advection for rotational consistency, and for exact reproducibility across PE layouts by using reproducing sums to detect convergence. This also includes some changes to use roundoff to detect convergence instead of fixed values. Also replaced some divisions with multiplication by a reciprocal. In addition, some of the optional arguments to advect_tracer that are only used for offline tracer advection were renamed or revised for clarity and reordered for the convenience of the non-offline-tracer code. Although answers with the offline tracer code will change slightly because of this refactoring, because of some bugs that were fixed in another recent commit, it was previously impossible to have run the offline tracer cases at all. All answers and output in the MOM6-examples regression suite are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 132 +++++++++++++++---------------- src/tracer/MOM_offline_main.F90 | 129 +++++++++++++++--------------- src/tracer/MOM_tracer_advect.F90 | 49 ++++++------ 3 files changed, 154 insertions(+), 156 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index b370dd6bb4..f95f2cd40e 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -70,7 +70,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) * G%IareaT(i,j) enddo ; enddo enddo @@ -102,11 +102,11 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) do j=js-1,je+1 do i=is-1,ie+1 ! Top layer - h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1) )) + h_new(i,j,1) = max(0.0, h_pre(i,j,1) + ((eb(i,j,1) - ea(i,j,2)) + ea(i,j,1))) h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer - h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) + h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + ((ea(i,j,nz) - eb(i,j,nz-1)) + eb(i,j,nz))) h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo @@ -140,13 +140,15 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) !! step [H ~> m or kg m-2] ! Local variables - integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux ! Net fluxes through the layer top [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net fluxes through the layer bottom [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux ! Net upward fluxes through the layer + ! top [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net downward fluxes through the layer + ! bottom [H ~> m or kg m-2] real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg m-2] real :: hvol ! Cell volume [H L2 ~> m3 or kg m-2] real :: scale_factor ! A nondimensional rescaling factor between 0 and 1 [nondim] real :: max_off_cfl ! The maximum permitted fraction that can leave in a timestep [nondim] + integer :: i, j, k, m, is, ie, js, je, nz max_off_cfl = 0.5 @@ -182,46 +184,33 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 hvol = h_pre(i,j,k) * G%areaT(i,j) - pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & - max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) + pos_flux = ((max(0.0, -uh(I-1,j,k)) + max(0.0, uh(I,j,k))) + & + (max(0.0, -vh(i,J-1,k)) + max(0.0, vh(i,J,k)))) + & + (max(0.0, top_flux(i,j,k)) + max(0.0, bottom_flux(i,j,k))) * G%areaT(i,j) if (pos_flux>hvol .and. pos_flux>0.0) then - scale_factor = (hvol / pos_flux)*max_off_cfl + scale_factor = (hvol / pos_flux) * max_off_cfl else ! Don't scale scale_factor = 1.0 endif ! Scale horizontal fluxes - if (-uh(I-1,j,k)>0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor - if (uh(I,j,k)>0) uh(I,j,k) = uh(I,j,k)*scale_factor - if (-vh(i,J-1,k)>0) vh(i,J-1,k) = vh(i,J-1,k)*scale_factor - if (vh(i,J,k)>0) vh(i,J,k) = vh(i,J,k)*scale_factor - - if (k>1 .and. k0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if (bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale top layer - elseif (k==1) then - if (top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor - if (bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale bottom layer - elseif (k==nz) then - if (top_flux(i,j,k)>0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if (bottom_flux(i,j,k)>0.0) eb(i,j,k) = eb(i,j,k)*scale_factor + if (-uh(I-1,j,k) > 0.0) uh(I-1,j,k) = uh(I-1,j,k) * scale_factor + if (uh(I,j,k) > 0.0) uh(I,j,k) = uh(I,j,k) * scale_factor + if (-vh(i,J-1,k) > 0.0) vh(i,J-1,k) = vh(i,J-1,k) * scale_factor + if (vh(i,J,k) > 0.0) vh(i,J,k) = vh(i,J,k) * scale_factor + + ! Scale the flux across the interface atop a layer if it is upward + if (top_flux(i,j,k) > 0.0) then + ea(i,j,k) = ea(i,j,k) * scale_factor + if (k > 1) & + eb(i,j,k-1) = eb(i,j,k-1) * scale_factor + endif + ! Scale the flux across the interface atop a layer if it is downward + if (bottom_flux(i,j,k) > 0.0) then + eb(i,j,k) = eb(i,j,k) * scale_factor + if (k < nz) & + ea(i,j,k+1) = ea(i,j,k+1) * scale_factor endif enddo ; enddo ; enddo @@ -244,6 +233,8 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] real, dimension(SZI_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: abs_uh_sum ! The vertical sum of the absolute value of the transports [H L2 ~> m3 or kg] + real :: new_uh_sum ! The vertically summed transports after redistribution [H L2 ~> m3 or kg] real :: uh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz @@ -253,7 +244,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) do j=js,je uh2d_sum(:) = 0.0 ! Copy over uh to a working array and sum up the remaining fluxes in a column - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh2d(I,k) = uh(I,j,k) uh2d_sum(I) = uh2d_sum(I) + uh2d(I,k) enddo ; enddo @@ -265,13 +256,13 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) if (hvol(i,j,k)>0.) then h2d_sum(i) = h2d_sum(i) + h2d(i,k) else - h2d(i,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) + h2d(i,k) = GV%H_subroundoff * G%areaT(i,j) endif enddo ; enddo ! Distribute flux. Note min/max is intended to make sure that the mass transport ! does not deplete a cell - do i=is-1,ie + do I=is-1,ie if ( uh2d_sum(I)>0.0 ) then do k=1,nz uh2d(I,k) = uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)) @@ -285,16 +276,20 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) uh2d(I,k) = 0.0 enddo endif - ! Calculate and check that column integrated transports match the original to - ! within the tolerance limit + + ! Check that column integrated transports match the original to within roundoff. uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) - ! ### This test may not work if GV%Angstrom_H is set to 0. - ! Instead try the max of this and ~roundoff compared with absolute transports? - if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & - call MOM_error(WARNING, "Column integral of uh does not match after barotropic redistribution") + abs_uh_sum = 0.0 ; new_uh_sum = 0.0 + do k=1,nz + abs_uh_sum = abs_uh_sum + abs(uh2d(j,k)) + new_uh_sum = new_uh_sum + uh2d(j,k) + enddo + if ( abs(new_uh_sum - uh2d_sum(j)) > max(uh_neglect, (5.0e-16*nz)*abs_uh_sum) ) & + call MOM_error(WARNING, "Column integral of uh does not match after "//& + "barotropic redistribution") enddo - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo enddo @@ -317,6 +312,8 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] real, dimension(SZJ_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: abs_vh_sum ! The vertical sum of the absolute value of the transports [H L2 ~> m3 or kg] + real :: new_vh_sum ! The vertically summed transports after redistribution [H L2 ~> m3 or kg] real :: vh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz @@ -326,7 +323,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) do i=is,ie vh2d_sum(:) = 0.0 ! Copy over uh to a working array and sum up the remaining fluxes in a column - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh2d(J,k) = vh(i,J,k) vh2d_sum(J) = vh2d_sum(J) + vh2d(J,k) enddo ; enddo @@ -338,12 +335,12 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) if (hvol(i,j,k)>0.) then h2d_sum(j) = h2d_sum(j) + h2d(j,k) else - h2d(j,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) + h2d(i,k) = GV%H_subroundoff * G%areaT(i,j) endif enddo ; enddo ! Distribute flux evenly throughout a column - do j=js-1,je + do J=js-1,je if ( vh2d_sum(J)>0.0 ) then do k=1,nz vh2d(J,k) = vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)) @@ -357,19 +354,20 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) vh2d(J,k) = 0.0 enddo endif - ! Calculate and check that column integrated transports match the original to - ! within the tolerance limit - vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) - ! ### This test may not work if GV%Angstrom_H is set to 0. - ! Instead try the max of this and ~roundoff compared with absolute transports? - if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then - call MOM_error(WARNING,"Column integral of vh does not match after "//& - "barotropic redistribution") - endif + ! Check that column integrated transports match the original to within roundoff. + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) + abs_vh_sum = 0.0 ; new_vh_sum = 0.0 + do k=1,nz + abs_vh_sum = abs_vh_sum + abs(vh2d(J,k)) + new_vh_sum = new_vh_sum + vh2d(J,k) + enddo + if ( abs(new_vh_sum - vh2d_sum(J)) > max(vh_neglect, (5.0e-16*nz)*abs_vh_sum) ) & + call MOM_error(WARNING, "Column integral of vh does not match after "//& + "barotropic redistribution") enddo - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo enddo @@ -411,7 +409,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) h2d(i,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo - do i=is-1,ie + do I=is-1,ie uh_col = SUM(uh2d(I,:)) ! Store original column-integrated transport do k=1,nz uh_remain = uh2d(I,k) @@ -466,7 +464,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ! i-loop - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo enddo @@ -502,14 +500,14 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) do i=is,ie ! Copy over uh and cell volume to working arrays - do k=1,nz ; do j=js-2,je+1 + do k=1,nz ; do J=js-2,je+1 vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 h2d(j,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo - do j=js-1,je + do J=js-1,je vh_col = SUM(vh2d(J,:)) do k=1,nz vh_remain = vh2d(J,k) @@ -565,7 +563,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) endif enddo - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo enddo diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 72041fbc86..d5b3f708a3 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -6,6 +6,7 @@ module MOM_offline_main use MOM_ALE, only : ALE_CS, ALE_main_offline, ALE_offline_inputs use MOM_checksums, only : hchksum, uvchksum +use MOM_coms, only : reproducing_sum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE @@ -13,7 +14,7 @@ module MOM_offline_main use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_diabatic_aux, only : tridiagTS use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field -use MOM_domains, only : sum_across_PEs, pass_var, pass_vector +use MOM_domains, only : pass_var, pass_vector use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : read_param, get_param, log_version, param_file_type @@ -39,7 +40,6 @@ module MOM_offline_main implicit none ; private #include "MOM_memory.h" -#include "version_variable.h" !> The control structure for the offline transport module type, public :: offline_transport_CS ; private @@ -305,7 +305,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C call hchksum(h_pre, "h_pre before transport", G%HI, scale=GV%H_to_m) call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) endif - tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) @@ -328,15 +328,15 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C endif call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & - uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhtr, vhr_out=vhtr) ! Switch the direction every iteration x_before_y = .not. x_before_y ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) !### Replace with "* G%IareaT(i,j)" + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -367,7 +367,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C ! Check for whether we've used up all the advection, or if we need to move on because ! advection has stalled - tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) @@ -478,9 +478,6 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve call pass_var(h_vol,G%Domain) call pass_vector(uhtr, vhtr, G%Domain) - ! Store volumes for advect_tracer - h_pre(:,:,:) = h_vol(:,:,:) - if (CS%debug) then call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) @@ -495,8 +492,8 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve endif call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & - h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -506,7 +503,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -522,9 +519,6 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve call pass_var(h_vol, G%Domain) call pass_vector(uhtr, vhtr, G%Domain) - ! Copy h_vol to h_pre for advect_tracer routine - h_pre(:,:,:) = h_vol(:,:,:) - if (CS%debug) then call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) @@ -539,8 +533,8 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve endif call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & - h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -550,14 +544,14 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! redistribute barotropic ! Check to see if all transport has been exhausted - tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) @@ -597,39 +591,40 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve end subroutine offline_redistribute_residual !> Returns the sums of any non-negligible remaining transport [H L2 ~> m3 or kg] to check for advection convergence -real function remaining_transport_sum(G, GV, uhtr, vhtr) +real function remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) 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(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in ) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in ) :: h_new !< Layer thicknesses [H ~> m or kg m-2] ! Local variables - integer :: i, j, k - integer :: is, ie, js, je, nz - real :: h_min !< A layer thickness below roundoff from GV type - real :: uh_neglect !< A small value of zonal transport that effectively is below roundoff error - real :: vh_neglect !< A small value of meridional transport that effectively is below roundoff error + real, dimension(SZI_(G),SZJ_(G)) :: trans_rem_col !< The vertical sum of the absolute value of + !! transports through the faces of a column, in MKS units [kg]. + real :: trans_cell !< The sum of the absolute value of the remaining transports through the faces + !! of a tracer cell [H L2 ~> m3 or kg] + real :: HL2_to_kg_scale !< Unit conversion factor to cell mass [kg H-1 L-2 ~> kg m-3 or 1] + integer :: i, j, k, is, ie, js, je, nz - nz = GV%ke - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - h_min = GV%H_subroundoff + HL2_to_kg_scale = GV%H_to_kg_m2 * US%L_to_m**2 - remaining_transport_sum = 0. + trans_rem_col(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - uh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i+1,j)) - vh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i,j+1)) - if (ABS(uhtr(I,j,k))>uh_neglect) then - remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) - endif - if (ABS(vhtr(i,J,k))>vh_neglect) then - remaining_transport_sum = remaining_transport_sum + ABS(vhtr(i,J,k)) - endif + trans_cell = (ABS(uhtr(I-1,j,k)) + ABS(uhtr(I,j,k))) + & + (ABS(vhtr(i,J-1,k)) + ABS(vhtr(i,J,k))) + if (trans_cell > max(1.0e-16*h_new(i,j,k), GV%H_subroundoff) * G%areaT(i,j)) & + trans_rem_col(i,j) = trans_rem_col(i,j) + HL2_to_kg_scale * trans_cell enddo ; enddo ; enddo - !### The value of this sum is not layout independent. - call sum_across_PEs(remaining_transport_sum) + + ! The factor of 0.5 here is to avoid double-counting because two cells share a face. + remaining_transport_sum = 0.5 * GV%kg_m2_to_H*US%m_to_L**2 * & + reproducing_sum(trans_rem_col, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) end function remaining_transport_sum @@ -854,11 +849,14 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, ! Remaining meridional mass transports [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub - real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are [H L2 ~> m3 or kg] - ! Vertical diffusion related variables [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJB_(G)) :: rem_col_flux ! The summed absolute value of the remaining + ! fluxes through the faces of a column or within a column, in mks units [kg] + real :: sum_flux ! Globally summed absolute value of fluxes in mks units [kg], which is + ! used to keep track of how close to convergence we are. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - eatr_sub, & - ebtr_sub + eatr_sub, & ! Layer entrainment rate from above for this sub-cycle [H ~> m or kg m-2] + ebtr_sub ! Layer entrainment rate from below for this sub-cycle [H ~> m or kg m-2] ! Variables used to keep track of layer thicknesses at various points in the code real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_new, & ! Updated thicknesses [H ~> m or kg m-2] @@ -899,7 +897,6 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo - ! Calculate 3d mass transports to be used in this iteration call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) @@ -920,11 +917,11 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, max_iter_in=30) ! Done with horizontal so now h_pre should be h_new do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif @@ -936,12 +933,12 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, CS%tracer_adv_CSp, & + CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, max_iter_in=30) ! Done with horizontal so now h_pre should be h_new do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo ! Second vertical advection @@ -973,28 +970,25 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, call pass_var(ebtr,G%Domain) call pass_var(h_pre,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) - ! + ! Calculate how close we are to converging by summing the remaining fluxes at each point - sum_abs_fluxes = 0.0 - sum_u = 0.0 - sum_v = 0.0 + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 + rem_col_flux(:,:) = 0.0 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)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + rem_col_flux(i,j) = rem_col_flux(i,j) + HL2_to_kg_scale * & + ( (abs(eatr(i,j,k)) + abs(ebtr(i,j,k))) + & + ((abs(uhtr(I-1,j,k)) + abs(uhtr(I,j,k))) + & + (abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k))) ) ) enddo ; enddo ; enddo - call sum_across_PEs(sum_abs_fluxes) - - HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 + sum_flux = reproducing_sum(rem_col_flux, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) - write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", & - sum_u*HL2_to_kg_scale, sum_v*HL2_to_kg_scale - call MOM_mesg(mesg) - if (sum_abs_fluxes==0) then + if (sum_flux==0) then write(mesg,*) 'offline_advection_layer: Converged after iteration', iter call MOM_mesg(mesg) exit + else + write(mesg,*) "offline_advection_layer: Iteration ", iter, " remaining total fluxes: ", sum_flux + call MOM_mesg(mesg) endif ! Switch order of Strang split every iteration @@ -1321,7 +1315,8 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method - + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -1336,7 +1331,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) return endif allocate(CS) - call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") + call log_version(param_file, mdl, version, "This module allows for tracers to be run offline") ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 1ad6343cf8..e2c669fcc7 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -47,36 +47,41 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -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) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first_in, & + vol_prev, max_iter_in, update_vol_prev, uhr_out, vhr_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_(GV)), & - intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] + intent(in) :: h_end !< Layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] + intent(in) :: uhtr !< Accumulated volume or mass flux through the + !! zonal faces [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] + intent(in) :: vhtr !< Accumulated volume or mass flux through the + !! meridional faces [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_(GV)), & - optional, intent(in) :: h_prev_opt !< Cell volume before advection [H L2 ~> m3 or kg] - 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. + ! The remaining optional arguments are only used in offline tracer mode. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(inout) :: vol_prev !< Cell volume before advection [H L2 ~> m3 or kg]. + !! If update_vol_prev is true, the returned value is + !! the cell volume after the transport that was done + !! by this call, and if all the transport could be + !! accommodated it should be close to h_end*G%areaT. + integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations + logical, optional, intent(in) :: update_vol_prev !< If present and true, update vol_prev to + !! return its value after the tracer have been updated. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: uhr_out !< Remaining accumulated volume/mass flux through zonal face - !! [H L2 ~> m3 or kg] + optional, intent(out) :: uhr_out !< Remaining accumulated volume or mass fluxes + !! through the zonal faces [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(out) :: vhr_out !< Remaining accumulated volume/mass flux through meridional face - !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: h_out !< Cell volume after the transport that was done - !! by this call [H L2 ~> m3 or kg]. If all the transport - !! could be accommodated, this is close to h_end*G%areaT. + optional, intent(out) :: vhr_out !< Remaining accumulated volume or mass fluxes + !! through the meridional faces [H L2 ~> m3 or kg] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -137,9 +142,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & enddo call cpu_clock_end(id_clock_pass) -!$OMP parallel default(none) shared(nz,jsd,jed,IsdB,IedB,uhr,jsdB,jedB,Isd,Ied,vhr, & -!$OMP hprev,domore_k,js,je,is,ie,uhtr,vhtr,G,GV,h_end,& -!$OMP uh_neglect,vh_neglect,ntr,Tr,h_prev_opt) + !$OMP parallel default(shared) ! This initializes the halos of uhr and vhr because pass_vector might do ! calculations on them, even though they are never used. @@ -152,7 +155,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! Put the remaining (total) thickness fluxes into uhr and vhr. do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = vhtr(i,J,k) ; enddo ; enddo - if (.not. present(h_prev_opt)) then + if (.not. present(vol_prev)) then ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. @@ -167,7 +170,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & enddo ; enddo else do i=is,ie ; do j=js,je - hprev(i,j,k) = h_prev_opt(i,j,k) + hprev(i,j,k) = vol_prev(i,j,k) enddo ; enddo endif enddo @@ -326,7 +329,9 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & if (present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) if (present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) - if (present(h_out)) h_out(:,:,:) = hprev(:,:,:) + if (present(vol_prev) .and. present(update_vol_prev)) then + if (update_vol_prev) vol_prev(:,:,:) = hprev(:,:,:) + endif call cpu_clock_end(id_clock_advect) From cf931b1e42ae3b4de53a9c8e4dc3dd9a3bbec976 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 Dec 2021 03:28:11 -0500 Subject: [PATCH 107/138] Eliminate unneeded diagnostic arrays Eliminated 18 unnecessary 3-d allocatable arrays and 5 2-d allocatable arrays from the MOM_diagnostics control structure, replacing them with reused local stack arrays. Also collected the registration of time derivatives and the allocation of memory for intermediary diagnostics in set_dependent_diagnostics. All answers and output are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 530 +++++++++++----------------- 1 file changed, 206 insertions(+), 324 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9979ecb5b1..e06cb235c4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -63,52 +63,12 @@ module MOM_diagnostics ! following arrays store diagnostics calculated here and unavailable outside. - ! following fields have nz+1 levels. - real, allocatable :: e(:,:,:) !< interface height [Z ~> m] - real, allocatable :: e_D(:,:,:) !< interface height above bottom [Z ~> m] - ! following fields have nz layers. real, allocatable :: du_dt(:,:,:) !< net i-acceleration [L T-2 ~> m s-2] real, allocatable :: dv_dt(:,:,:) !< net j-acceleration [L T-2 ~> m s-2] real, allocatable :: dh_dt(:,:,:) !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] - real, allocatable :: p_ebt(:,:,:) !< Equivalent barotropic modal structure [nondim] - ! real, allocatable :: hf_du_dt(:,:,:), hf_dv_dt(:,:,:) !< du_dt, dv_dt x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - - real, allocatable :: h_Rlay(:,:,:) !< Layer thicknesses in potential density - !! coordinates [H ~> m or kg m-2] - real, allocatable :: uh_Rlay(:,:,:) !< Zonal transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, allocatable :: vh_Rlay(:,:,:) !< Meridional transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, allocatable :: uhGM_Rlay(:,:,:) !< Zonal Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, allocatable :: vhGM_Rlay(:,:,:) !< Meridional Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - - ! following fields are 2-D. - real, allocatable :: cg1(:,:) !< First baroclinic gravity wave speed [L T-1 ~> m s-1] - real, allocatable :: Rd1(:,:) !< First baroclinic deformation radius [L ~> m] - real, allocatable :: cfl_cg1(:,:) !< CFL for first baroclinic gravity wave speed [nondim] - real, allocatable :: cfl_cg1_x(:,:) !< i-component of CFL for first baroclinic gravity wave speed [nondim] - real, allocatable :: cfl_cg1_y(:,:) !< j-component of CFL for first baroclinic gravity wave speed [nondim] - - ! The following arrays hold diagnostics in the layer-integrated energy budget. - real, allocatable :: KE(:,:,:) !< KE per unit mass [L2 T-2 ~> m2 s-2] - real, allocatable :: dKE_dt(:,:,:) !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] - real, allocatable :: PE_to_KE(:,:,:) !< potential energy to KE term [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_BT(:,:,:) !< barotropic contribution to KE term [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_CorAdv(:,:,:) !< KE source from the combined Coriolis and - !! advection terms [H L2 T-3 ~> m3 s-3]. - !! The Coriolis source should be zero, but is not due to truncation - !! errors. There should be near-cancellation of the global integral - !! of this spurious Coriolis source. - real, allocatable :: KE_adv(:,:,:) !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_visc(:,:,:) !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_stress(:,:,:) !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_horvisc(:,:,:) !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_dia(:,:,:) !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] + + logical :: KE_term_on !< If true, at least one diagnostic term in the KE budget is in use. !>@{ Diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 @@ -233,10 +193,20 @@ 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 :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, either relative to a reference + ! geopotential or the seafloor [Z ~> m]. 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_3d(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary work array in various units + ! including [nondim] and [H ~> m or kg m-2]. + real :: uh_tmp(SZIB_(G),SZJ_(G),SZK_(GV)) ! A temporary zonal transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vh_tmp(SZI_(G),SZJB_(G),SZK_(GV)) ! A temporary meridional transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] + real :: cg1(SZI_(G),SZJ_(G)) ! First baroclinic gravity wave speed [L T-1 ~> m s-1] + real :: Rd1(SZI_(G),SZJ_(G)) ! First baroclinic deformation radius [L ~> m] + real :: CFL_cg1(SZI_(G),SZJ_(G)) ! CFL for first baroclinic gravity wave speed, either based on the + ! overall grid spacing or just one direction [nondim] + ! tmp array for surface properties real :: surface_field(SZI_(G),SZJ_(G)) @@ -330,32 +300,32 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_uv, uv, CS%diag) endif - if (allocated(CS%e)) then - call find_eta(h, tv, G, GV, US, CS%e, dZref=G%Z_ref) - if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) - endif - - if (allocated(CS%e_D)) then - if (allocated(CS%e)) then + ! Find the interface heights, relative either to a reference height or to the bottom [Z ~> m]. + if (CS%id_e > 0) then + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) + if (CS%id_e > 0) call post_data(CS%id_e, eta, CS%diag) + if (CS%id_e_D > 0) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + (G%bathyT(i,j) + G%Z_ref) - enddo ; enddo ; enddo - else - call find_eta(h, tv, G, GV, US, CS%e_D) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) + eta(i,j,k) = eta(i,j,k) + (G%bathyT(i,j) + G%Z_ref) enddo ; enddo ; enddo + call post_data(CS%id_e_D, eta, CS%diag) endif - - if (CS%id_e_D > 0) call post_data(CS%id_e_D, CS%e_D, CS%diag) + elseif (CS%id_e_D > 0) then + call find_eta(h, tv, G, GV, US, eta) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + eta(i,j,k) = eta(i,j,k) + G%bathyT(i,j) + enddo ; enddo ; enddo + call post_data(CS%id_e_D, eta, CS%diag) endif - ! mass per area of grid cell (for Bouss, use Rho0) + ! mass per area of grid cell (for Boussinesq, use Rho0) if (CS%id_masscello > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_kg_m2*h(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_masscello, work_3d, CS%diag) + !### If the registration call has conversion=GV%H_to_kg, the mathematically equivalent form would be: + ! call post_data(CS%id_masscello, h, CS%diag) endif ! mass of liquid ocean (for Bouss, use Rho0). The reproducing sum requires the use of MKS units. @@ -500,9 +470,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) - if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. allocated(CS%h_Rlay) .or. & - allocated(CS%uh_Rlay) .or. allocated(CS%vh_Rlay) .or. & - allocated(CS%uhGM_Rlay) .or. allocated(CS%vhGM_Rlay)) then + if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. (CS%id_h_Rlay > 0) .or. & + (CS%id_uh_Rlay > 0) .or. (CS%id_vh_Rlay > 0) .or. & + (CS%id_uhGM_Rlay > 0) .or. (CS%id_vhGM_Rlay > 0)) then if (associated(tv%eqn_of_state)) then EOSdom(:) = EOS_domain(G%HI, halo=1) @@ -520,110 +490,112 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_Rml > 0) call post_data(CS%id_Rml, Rcv, CS%diag) if (CS%id_Rcv > 0) call post_data(CS%id_Rcv, Rcv, CS%diag) - if (allocated(CS%h_Rlay)) then + if (CS%id_h_Rlay > 0) then + ! Here work_3d is used for the layer thicknesses in potential density coordinates [H ~> m or kg m-2]. k_list = nz/2 -!$OMP parallel do default(none) shared(is,ie,js,je,nz,nkmb,CS,Rcv,h,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do i=is,ie - CS%h_Rlay(i,j,k) = 0.0 + work_3d(i,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%h_Rlay(i,j,k) = h(i,j,k) + work_3d(i,j,k) = h(i,j,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, Rcv(i,j,k), k_list, nz, wt, wt_p) - CS%h_Rlay(i,j,k_list) = CS%h_Rlay(i,j,k_list) + h(i,j,k)*wt - CS%h_Rlay(i,j,k_list+1) = CS%h_Rlay(i,j,k_list+1) + h(i,j,k)*wt_p + work_3d(i,j,k_list) = work_3d(i,j,k_list) + h(i,j,k)*wt + work_3d(i,j,k_list+1) = work_3d(i,j,k_list+1) + h(i,j,k)*wt_p enddo ; enddo enddo - if (CS%id_h_Rlay > 0) call post_data(CS%id_h_Rlay, CS%h_Rlay, CS%diag) + call post_data(CS%id_h_Rlay, work_3d, CS%diag) endif - if (allocated(CS%uh_Rlay)) then + if (CS%id_uh_Rlay > 0) then + ! Calculate zonal transports in potential density coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CS,GV,uh) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = 0.0 + uh_tmp(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = uh(I,j,k) + uh_tmp(I,j,k) = uh(I,j,k) enddo ; enddo k_list = nz/2 do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + uh(I,j,k)*wt - CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + uh(I,j,k)*wt_p + uh_tmp(I,j,k_list) = uh_tmp(I,j,k_list) + uh(I,j,k)*wt + uh_tmp(I,j,k_list+1) = uh_tmp(I,j,k_list+1) + uh(I,j,k)*wt_p enddo ; enddo enddo - if (CS%id_uh_Rlay > 0) call post_data(CS%id_uh_Rlay, CS%uh_Rlay, CS%diag) + call post_data(CS%id_uh_Rlay, uh_tmp, CS%diag) endif - if (allocated(CS%vh_Rlay)) then + if (CS%id_vh_Rlay > 0) then + ! Calculate meridional transports in potential density coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,nz,nkmb,Rcv,CS,GV,vh) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do J=Jsq,Jeq do k=1,nkmb ; do i=is,ie - CS%vh_Rlay(i,J,k) = 0.0 + vh_tmp(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vh_Rlay(i,J,k) = vh(i,J,k) + vh_tmp(i,J,k) = vh(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + vh(i,J,k)*wt - CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + vh(i,J,k)*wt_p + vh_tmp(i,J,k_list) = vh_tmp(i,J,k_list) + vh(i,J,k)*wt + vh_tmp(i,J,k_list+1) = vh_tmp(i,J,k_list+1) + vh(i,J,k)*wt_p enddo ; enddo enddo - if (CS%id_vh_Rlay > 0) call post_data(CS%id_vh_Rlay, CS%vh_Rlay, CS%diag) + call post_data(CS%id_vh_Rlay, vh_tmp, CS%diag) endif - if (allocated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then + if ((CS%id_uhGM_Rlay > 0) .and. associated(CDp%uhGM)) then + ! Calculate zonal Gent-McWilliams transports in potential density + ! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CDP,CS,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do I=Isq,Ieq - CS%uhGM_Rlay(I,j,k) = 0.0 + uh_tmp(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uhGM_Rlay(I,j,k) = CDp%uhGM(I,j,k) + uh_tmp(I,j,k) = CDp%uhGM(I,j,k) enddo ; enddo do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uhGM_Rlay(I,j,k_list) = CS%uhGM_Rlay(I,j,k_list) + CDp%uhGM(I,j,k)*wt - CS%uhGM_Rlay(I,j,k_list+1) = CS%uhGM_Rlay(I,j,k_list+1) + CDp%uhGM(I,j,k)*wt_p + uh_tmp(I,j,k_list) = uh_tmp(I,j,k_list) + CDp%uhGM(I,j,k)*wt + uh_tmp(I,j,k_list+1) = uh_tmp(I,j,k_list+1) + CDp%uhGM(I,j,k)*wt_p enddo ; enddo enddo - if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) + if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, uh_tmp, CS%diag) endif - if (allocated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then + if ((CS%id_vhGM_Rlay > 0) .and. associated(CDp%vhGM)) then + ! Calculate meridional Gent-McWilliams transports in potential density + ! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(is,ie,Jsq,Jeq,nz,nkmb,CS,CDp,Rcv,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do J=Jsq,Jeq do k=1,nkmb ; do i=is,ie - CS%vhGM_Rlay(i,J,k) = 0.0 + vh_tmp(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vhGM_Rlay(i,J,k) = CDp%vhGM(i,J,k) + vh_tmp(i,J,k) = CDp%vhGM(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vhGM_Rlay(i,J,k_list) = CS%vhGM_Rlay(i,J,k_list) + CDp%vhGM(i,J,k)*wt - CS%vhGM_Rlay(i,J,k_list+1) = CS%vhGM_Rlay(i,J,k_list+1) + CDp%vhGM(i,J,k)*wt_p + vh_tmp(i,J,k_list) = vh_tmp(i,J,k_list) + CDp%vhGM(i,J,k)*wt + vh_tmp(i,J,k_list+1) = vh_tmp(i,J,k_list+1) + CDp%vhGM(i,J,k)*wt_p enddo ; enddo enddo - if (CS%id_vhGM_Rlay > 0) call post_data(CS%id_vhGM_Rlay, CS%vhGM_Rlay, CS%diag) + if (CS%id_vhGM_Rlay > 0) call post_data(CS%id_vhGM_Rlay, vh_tmp, CS%diag) endif endif @@ -680,8 +652,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0)) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) - if (CS%id_cg1>0) call post_data(CS%id_cg1, CS%cg1, CS%diag) + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed) + if (CS%id_cg1>0) call post_data(CS%id_cg1, cg1, CS%diag) if (CS%id_Rd1>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) do j=js,je ; do i=is,ie @@ -694,42 +666,44 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) )) - CS%Rd1(i,j) = CS%cg1(i,j) / sqrt(f2_h + CS%cg1(i,j) * mag_beta) + Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta) enddo ; enddo - call post_data(CS%id_Rd1, CS%Rd1, CS%diag) + call post_data(CS%id_Rd1, Rd1, CS%diag) endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CFL_cg1(i,j) = (dt*cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) enddo ; enddo - call post_data(CS%id_cfl_cg1, CS%cfl_cg1, CS%diag) + call post_data(CS%id_cfl_cg1, CFL_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*CS%cg1(i,j)) * G%IdxT(i,j) + CFL_cg1(i,j) = (dt*cg1(i,j)) * G%IdxT(i,j) enddo ; enddo - call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) + call post_data(CS%id_cfl_cg1_x, CFL_cg1, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*CS%cg1(i,j)) * G%IdyT(i,j) + CFL_cg1(i,j) = (dt*cg1(i,j)) * G%IdyT(i,j) enddo ; enddo - call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) + call post_data(CS%id_cfl_cg1_y, CFL_cg1, CS%diag) endif endif if ((CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then if (CS%id_p_ebt>0) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & + ! Here work_3d is used for the equivalent barotropic modal structure [nondim]. + work_3d(:,:,:) = 0.0 + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & - mono_N2_depth=CS%mono_N2_depth, modal_structure=CS%p_ebt) - call post_data(CS%id_p_ebt, CS%p_ebt, CS%diag) + mono_N2_depth=CS%mono_N2_depth, modal_structure=work_3d) + call post_data(CS%id_p_ebt, work_3d, CS%diag) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth) endif - if (CS%id_cg_ebt>0) call post_data(CS%id_cg_ebt, CS%cg1, CS%diag) + if (CS%id_cg_ebt>0) call post_data(CS%id_cg_ebt, cg1, CS%diag) if (CS%id_Rd_ebt>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) do j=js,je ; do i=is,ie @@ -742,10 +716,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) )) - CS%Rd1(i,j) = CS%cg1(i,j) / sqrt(f2_h + CS%cg1(i,j) * mag_beta) + Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta) enddo ; enddo - call post_data(CS%id_Rd_ebt, CS%Rd1, CS%diag) + call post_data(CS%id_Rd_ebt, Rd1, CS%diag) endif endif @@ -762,8 +736,8 @@ subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) integer, intent(inout) :: k !< The value of k such that Rlist(k) <= R_in < Rlist(k+1) !! The input value is a first guess integer, intent(in) :: nz !< The number of layers in Rlist - real, intent(out) :: wt !< The weight of layer k for interpolation, nondim - real, intent(out) :: wt_p !< The weight of layer k+1 for interpolation, nondim + real, intent(out) :: wt !< The weight of layer k for interpolation [nondim] + real, intent(out) :: wt_p !< The weight of layer k+1 for interpolation [nondim] ! This subroutine finds location of R_in in an increasing ordered ! list, Rlist, returning as k the element such that @@ -960,41 +934,39 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to !! diagnostics_init. -! This subroutine calculates terms in the mechanical energy budget. - ! Local variables - real :: KE_u(SZIB_(G),SZJ_(G)) - real :: KE_v(SZI_(G),SZJB_(G)) - real :: KE_h(SZI_(G),SZJ_(G)) + real :: KE(SZI_(G),SZJ_(G),SZK_(GV)) ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] + real :: KE_term(SZI_(G),SZJ_(G),SZK_(GV)) ! A term in the kinetic energy budget + ! [H L2 T-3 ~> m3 s-3 or W m-2] + real :: KE_u(SZIB_(G),SZJ_(G)) ! The area integral of a KE term in a layer at u-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real :: KE_v(SZI_(G),SZJB_(G)) ! The area integral of a KE term in a layer at v-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real :: KE_h(SZI_(G),SZJ_(G)) ! A KE term contribution at tracer points + ! [H L2 T-3 ~> m3 s-3 or W m-2] integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + if (.not.(CS%KE_term_on .or. (CS%id_KE > 0))) return + do j=js-1,je ; do i=is-1,ie KE_u(I,j) = 0.0 ; KE_v(i,J) = 0.0 enddo ; enddo - if (allocated(CS%KE)) then - do k=1,nz ; do j=js,je ; do i=is,ie - CS%KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & - + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 - ! DELETE THE FOLLOWING... Make this 0 to test the momentum balance, - ! or a huge number to test the continuity balance. - ! CS%KE(i,j,k) *= 1e20 - enddo ; enddo ; enddo - if (CS%id_KE > 0) call post_data(CS%id_KE, CS%KE, CS%diag) - endif + do k=1,nz ; do j=js,je ; do i=is,ie + KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & + + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 + enddo ; enddo ; enddo + if (CS%id_KE > 0) call post_data(CS%id_KE, KE, CS%diag) - if (.not.G%symmetric) then - if (allocated(CS%dKE_dt) .OR. allocated(CS%PE_to_KE) .OR. allocated(CS%KE_BT) .OR. & - allocated(CS%KE_CorAdv) .OR. allocated(CS%KE_adv) .OR. allocated(CS%KE_visc) .OR. & - allocated(CS%KE_horvisc) .OR. allocated(CS%KE_dia) ) then - call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) - endif + if (CS%KE_term_on .and. .not.G%symmetric) then + call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) endif - if (allocated(CS%dKE_dt)) then + if (CS%id_dKEdt > 0) then + ! Calculate the time derivative of the layer KE [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * CS%du_dt(I,j,k) @@ -1003,19 +975,20 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k) * CS%dh_dt(i,j,k) + KE_h(i,j) = KE(i,j,k) * CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%dKE_dt(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_dKEdt > 0) call post_data(CS%id_dKEdt, CS%dKE_dt, CS%diag) + call post_data(CS%id_dKEdt, KE_term, CS%diag) endif - if (allocated(CS%PE_to_KE)) then + if (CS%id_PE_to_KE > 0) then + ! Calculate the potential energy to KE term [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%PFu(I,j,k) @@ -1026,14 +999,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%PE_to_KE(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, CS%PE_to_KE, CS%diag) + if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, KE_term, CS%diag) endif - if (allocated(CS%KE_BT)) then + if (CS%id_KE_BT > 0) then + ! Calculate the barotropic contribution to KE term [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%u_accel_bt(I,j,k) @@ -1044,14 +1018,17 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_BT(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_BT > 0) call post_data(CS%id_KE_BT, CS%KE_BT, CS%diag) + call post_data(CS%id_KE_BT, KE_term, CS%diag) endif - if (allocated(CS%KE_CorAdv)) then + if (CS%id_KE_Coradv > 0) then + ! Calculate the KE source from the combined Coriolis and advection terms [H L2 T-3 ~> m3 s-3]. + ! The Coriolis source should be zero, but is not due to truncation errors. There should be + ! near-cancellation of the global integral of this spurious Coriolis source. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%CAu(I,j,k) @@ -1060,21 +1037,22 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) & + KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) & * (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_CorAdv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_Coradv > 0) call post_data(CS%id_KE_Coradv, CS%KE_Coradv, CS%diag) + call post_data(CS%id_KE_Coradv, KE_term, CS%diag) endif - if (allocated(CS%KE_adv)) then - ! NOTE: All terms in KE_adv are multipled by -1, which can easily produce + if (CS%id_KE_adv > 0) then + ! Calculate the KE source from along-layer advection [H L2 T-3 ~> m3 s-3]. + ! NOTE: All terms in KE_adv are multiplied by -1, which can easily produce ! negative zeros and may signal a reproducibility issue over land. ! We resolve this by re-initializing and only evaluating over water points. KE_u(:,:) = 0. ; KE_v(:,:) = 0. @@ -1088,20 +1066,21 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%gradKEv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) & + KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) & * (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_adv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_adv > 0) call post_data(CS%id_KE_adv, CS%KE_adv, CS%diag) + call post_data(CS%id_KE_adv, KE_term, CS%diag) endif - if (allocated(CS%KE_visc)) then + if (CS%id_KE_visc > 0) then + ! Calculate the KE source from vertical viscosity [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc(I,j,k) @@ -1112,14 +1091,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_visc(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_visc > 0) call post_data(CS%id_KE_visc, CS%KE_visc, CS%diag) + call post_data(CS%id_KE_visc, KE_term, CS%diag) endif - if (allocated(CS%KE_stress)) then + if (CS%id_KE_stress > 0) then + ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_str(I,j,k) @@ -1130,14 +1110,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_stress(i,j,k) = 0.5 * G%IareaT(i,j) * & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) * & ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo - if (CS%id_KE_stress > 0) call post_data(CS%id_KE_stress, CS%KE_stress, CS%diag) + call post_data(CS%id_KE_stress, KE_term, CS%diag) endif - if (allocated(CS%KE_horvisc)) then + if (CS%id_KE_horvisc > 0) then + ! Calculate the KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%diffu(I,j,k) @@ -1148,14 +1129,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_horvisc(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_horvisc > 0) call post_data(CS%id_KE_horvisc, CS%KE_horvisc, CS%diag) + call post_data(CS%id_KE_horvisc, KE_term, CS%diag) endif - if (allocated(CS%KE_dia)) then + if (CS%id_KE_dia > 0) then + ! Calculate the KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_dia(I,j,k) @@ -1164,16 +1146,16 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k) * (CDp%diapyc_vel(i,j,k) - CDp%diapyc_vel(i,j,k+1)) + KE_h(i,j) = KE(i,j,k) * (CDp%diapyc_vel(i,j,k) - CDp%diapyc_vel(i,j,k+1)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_dia(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_dia > 0) call post_data(CS%id_KE_dia, CS%KE_dia, CS%diag) + call post_data(CS%id_KE_dia, KE_term, CS%diag) endif end subroutine calculate_energy_diagnostics @@ -1456,7 +1438,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tend ! Change in layer thickness due to dynamics ! [H T-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [T-1 ~> s-1] - real :: H_to_RZ_dt ! A conversion factor from accumulated transports to fluxes + 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 = GV%ke @@ -1516,7 +1498,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy end subroutine post_transport_diagnostics !> This subroutine registers various diagnostics and allocates space for fields -!! that other diagnostis depend upon. +!! that other diagnostics depend upon. subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag, CS, tv) type(ocean_internal_state), intent(in) :: MIS !< For "MOM Internal State" a set of pointers to !! the fields and accelerations that make up the @@ -1537,32 +1519,26 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag !! thermodynamic variables. ! Local variables - real :: omega, f2_min, convert_H - ! This include declares and sets the variable "version". -# include "version_variable.h" - character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. - character(len=48) :: thickness_units, flux_units real :: wave_speed_min ! A floor in the first mode speed below which 0 is returned [L T-1 ~> m s-1] real :: wave_speed_tol ! The fractional tolerance for finding the wave speeds [nondim] + real :: convert_H ! A conversion factor from internal thickness units to the appropriate + ! MKS units (m or kg m-2) for thicknesses depending on whether the + ! Boussinesq approximation is being made [m H-1 or kg m-2 H-1 ~> 1] logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. logical :: split ! True if using the barotropic-baroclinic split algorithm + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. + character(len=48) :: thickness_units, flux_units logical :: use_temperature, adiabatic logical :: default_2018_answers, remap_answers_2018 - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nkml, nkbl - integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j - - 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 = GV%ke - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB CS%initialized = .true. CS%diag => diag use_temperature = associated(tv%T) - call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & - do_not_log=.true.) + call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., do_not_log=.true.) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1600,7 +1576,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL,& - Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & + Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & !### , conversion=GV%H_to_kg_m2, & standard_name='sea_water_mass_per_unit_area', v_extensive=.true.) CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & @@ -1677,11 +1653,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & 'Interface Height Relative to Mean Sea Level', 'm', conversion=US%Z_to_m) - if (CS%id_e > 0) allocate(CS%e(isd:ied,jsd:jed,nz+1), source=0.) - CS%id_e_D = register_diag_field('ocean_model', 'e_D', diag%axesTi, Time, & 'Interface Height above the Seafloor', 'm', conversion=US%Z_to_m) - if (CS%id_e_D > 0) allocate(CS%e_D(isd:ied,jsd:jed,nz+1), source=0.) CS%id_Rml = register_diag_field('ocean_model', 'Rml', diag%axesTL, Time, & 'Mixed Layer Coordinate Potential Density', 'kg m-3', conversion=US%R_to_kg_m3) @@ -1702,115 +1675,54 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_du_dt>0) .and. .not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_dv_dt>0) .and. .not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) - if ((CS%id_dh_dt>0) .and. .not. allocated(CS%dh_dt)) then - allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) - endif !CS%id_hf_du_dt = register_diag_field('ocean_model', 'hf_dudt', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2, & ! v_extensive=.true.) - !if (CS%id_hf_du_dt > 0) then - ! call safe_alloc_ptr(CS%hf_du_dt,IsdB,IedB,jsd,jed,nz) - ! if (.not. allocated(CS%du_dt)) then - ! allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - ! call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - ! endif - ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif !CS%id_hf_dv_dt = register_diag_field('ocean_model', 'hf_dvdt', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2, & ! v_extensive=.true.) - !if (CS%id_hf_dv_dt > 0) then - ! call safe_alloc_ptr(CS%hf_dv_dt,isd,ied,JsdB,JedB,nz) - ! if (.not. allocated(CS%dv_dt)) then - ! allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - ! call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - ! endif - ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif CS%id_hf_du_dt_2d = register_diag_field('ocean_model', 'hf_dudt_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_du_dt_2d > 0) then - if (.not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif CS%id_hf_dv_dt_2d = register_diag_field('ocean_model', 'hf_dvdt_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_dv_dt_2d > 0) then - if (.not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif CS%id_h_du_dt = register_diag_field('ocean_model', 'h_du_dt', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_du_dt > 0) then - if (.not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_dv_dt = register_diag_field('ocean_model', 'h_dv_dt', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_dv_dt > 0) then - if (.not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) - endif ! layer thickness variables !if (GV%nk_rho_varies > 0) then CS%id_h_Rlay = register_diag_field('ocean_model', 'h_rho', diag%axesTL, Time, & 'Layer thicknesses in pure potential density coordinates', & thickness_units, conversion=convert_H) - if (CS%id_h_Rlay > 0) allocate(CS%h_Rlay(isd:ied,jsd:jed,nz), source=0.) CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uh_Rlay > 0) allocate(CS%uh_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vh_Rlay > 0) allocate(CS%vh_Rlay(isd:ied,JsdB:JedB,nz), source=0.) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & 'Zonal volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uhGM_Rlay>0) allocate(CS%uhGM_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & 'Meridional volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vhGM_Rlay>0) allocate(CS%vhGM_Rlay(isd:ied,JsdB:JedB,nz), source=0.) !endif @@ -1818,55 +1730,36 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE = register_diag_field('ocean_model', 'KE', diag%axesTL, Time, & 'Layer kinetic energy per unit mass', & 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (CS%id_KE > 0) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) - CS%id_dKEdt = register_diag_field('ocean_model', 'dKE_dt', diag%axesTL, Time, & 'Kinetic Energy Tendency of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_dKEdt > 0) allocate(CS%dKE_dt(isd:ied,jsd:jed,nz), source=0.) - CS%id_PE_to_KE = register_diag_field('ocean_model', 'PE_to_KE', diag%axesTL, Time, & 'Potential to Kinetic Energy Conversion of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_PE_to_KE > 0) allocate(CS%PE_to_KE(isd:ied,jsd:jed,nz), source=0.) - if (split) then CS%id_KE_BT = register_diag_field('ocean_model', 'KE_BT', diag%axesTL, Time, & 'Barotropic contribution to Kinetic Energy', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_BT > 0) allocate(CS%KE_BT(isd:ied,jsd:jed,nz), source=0.) endif - CS%id_KE_Coradv = register_diag_field('ocean_model', 'KE_Coradv', diag%axesTL, Time, & 'Kinetic Energy Source from Coriolis and Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_Coradv > 0) allocate(CS%KE_Coradv(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_adv = register_diag_field('ocean_model', 'KE_adv', diag%axesTL, Time, & 'Kinetic Energy Source from Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_adv > 0) allocate(CS%KE_adv(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_visc > 0) allocate(CS%KE_visc(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_stress > 0) allocate(CS%KE_stress(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_horvisc = register_diag_field('ocean_model', 'KE_horvisc', diag%axesTL, Time, & 'Kinetic Energy Source from Horizontal Viscosity', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_horvisc > 0) allocate(CS%KE_horvisc(isd:ied,jsd:jed,nz), source=0.) - if (.not. adiabatic) then CS%id_KE_dia = register_diag_field('ocean_model', 'KE_dia', diag%axesTL, Time, & 'Kinetic Energy Source from Diapycnal Diffusion', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_dia > 0) allocate(CS%KE_dia(isd:ied,jsd:jed,nz), source=0.) endif ! gravity wave CFLs @@ -1893,13 +1786,6 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) -!### call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018) - allocate(CS%cg1(isd:ied,jsd:jed), source=0.) - if (CS%id_Rd1 > 0 .or. CS%id_Rd_ebt > 0) allocate(CS%Rd1(isd:ied,jsd:jed), source=0.) - if (CS%id_cfl_cg1 > 0) allocate(CS%cfl_cg1(isd:ied,jsd:jed), source=0.) - if (CS%id_cfl_cg1_x > 0) allocate(CS%cfl_cg1_x(isd:ied,jsd:jed), source=0.) - if (CS%id_cfl_cg1_y > 0) allocate(CS%cfl_cg1_y(isd:ied,jsd:jed), source=0.) - if (CS%id_p_ebt > 0) allocate(CS%p_ebt(isd:ied,jsd:jed,nz), source=0.) endif CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & @@ -1928,6 +1814,8 @@ 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) + ! Register time derivatives and allocate memory for diagnostics that need + ! access from across several modules. call set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) end subroutine MOM_diagnostics_init @@ -2253,55 +2141,66 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) type(diagnostics_CS), intent(inout) :: 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 = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (allocated(CS%dKE_dt) .or. allocated(CS%PE_to_KE) .or. & - allocated(CS%KE_BT) .or. allocated(CS%KE_CorAdv) .or. & - allocated(CS%KE_adv) .or. allocated(CS%KE_visc) .or. allocated(CS%KE_stress) .or. & - allocated(CS%KE_horvisc) .or. allocated(CS%KE_dia)) then - if (.not. allocated(CS%KE)) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) + ! Allocate and register time derivatives. + if ( ( (CS%id_du_dt>0) .or. (CS%id_dKEdt > 0) .or. & + ! (CS%id_hf_du_dt > 0) .or. & + (CS%id_h_du_dt > 0) .or. (CS%id_hf_du_dt_2d > 0) ) .and. & + (.not. allocated(CS%du_dt)) ) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) + call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif - - if (allocated(CS%dKE_dt)) then - if (.not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - if (.not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - if (.not. allocated(CS%dh_dt)) then - allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) - endif + if ( ( (CS%id_dv_dt>0) .or. (CS%id_dKEdt > 0) .or. & + ! (CS%id_hf_dv_dt > 0) .or. & + (CS%id_h_dv_dt > 0) .or. (CS%id_hf_dv_dt_2d > 0) ) .and. & + (.not. allocated(CS%dv_dt)) ) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) + call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) + endif + if ( ( (CS%id_dh_dt>0) .or. (CS%id_dKEdt > 0) ) .and. & + (.not. allocated(CS%dh_dt)) ) then + allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) + call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif - if (allocated(CS%KE_adv)) then + ! Allocate memory for other dependent diagnostics. + if (CS%id_KE_adv > 0) then call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (allocated(CS%KE_visc)) then + if (CS%id_KE_visc > 0) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif - if (allocated(CS%KE_stress)) then + if (CS%id_KE_stress > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) endif - if (allocated(CS%KE_dia)) then + if (CS%id_KE_dia > 0) then call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) endif - if (allocated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) - if (allocated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) + CS%KE_term_on = ((CS%id_dKEdt > 0) .or. (CS%id_PE_to_KE > 0) .or. (CS%id_KE_BT > 0) .or. & + (CS%id_KE_Coradv > 0) .or. (CS%id_KE_adv > 0) .or. (CS%id_KE_visc > 0) .or. & + (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. (CS%id_KE_dia > 0)) + + if (CS%id_h_du_dt > 0) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) + + if (CS%id_hf_du_dt_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) + if (CS%id_hf_dv_dt_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) + ! if (CS%id_hf_du_dt > 0) call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) + ! if (CS%id_hf_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) + + if (CS%id_uhGM_Rlay > 0) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) + if (CS%id_vhGM_Rlay > 0) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) end subroutine set_dependent_diagnostics @@ -2315,26 +2214,9 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) !! equation. integer :: m - if (allocated(CS%e)) deallocate(CS%e) - if (allocated(CS%e_D)) deallocate(CS%e_D) - if (allocated(CS%KE)) deallocate(CS%KE) - if (allocated(CS%dKE_dt)) deallocate(CS%dKE_dt) - if (allocated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) - if (allocated(CS%KE_BT)) deallocate(CS%KE_BT) - if (allocated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) - if (allocated(CS%KE_adv)) deallocate(CS%KE_adv) - if (allocated(CS%KE_visc)) deallocate(CS%KE_visc) - if (allocated(CS%KE_stress)) deallocate(CS%KE_stress) - if (allocated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) - if (allocated(CS%KE_dia)) deallocate(CS%KE_dia) if (allocated(CS%dh_dt)) deallocate(CS%dh_dt) if (allocated(CS%dv_dt)) deallocate(CS%dv_dt) if (allocated(CS%du_dt)) deallocate(CS%du_dt) - if (allocated(CS%h_Rlay)) deallocate(CS%h_Rlay) - if (allocated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) - if (allocated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) - if (allocated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) - if (allocated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) if (associated(ADp%gradKEv)) deallocate(ADp%gradKEv) From 170fffd14441097d8b077066b3deb3b19925647c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 Dec 2021 03:31:03 -0500 Subject: [PATCH 108/138] MOM_sponge cleanup Use the proper conversion factor for the w_sponge diagnostic, eliminated some unnecessary local copies of the domain sizes in the sponge control structure, and added more detailed descriptions of some of the variables in this module. All answers and output are bitwise identical. --- src/parameterizations/vertical/MOM_sponge.F90 | 62 +++++++------------ 1 file changed, 21 insertions(+), 41 deletions(-) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 2699e57099..d0d64079c3 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -42,14 +42,6 @@ module MOM_sponge logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers and nkbl buffer layer. integer :: nz !< The total number of layers. - integer :: isc !< The starting i-index of the computational domain at h. - integer :: iec !< The ending i-index of the computational domain at h. - integer :: jsc !< The starting j-index of the computational domain at h. - integer :: jec !< The ending j-index of the computational domain at h. - integer :: isd !< The starting i-index of the data domain at h. - integer :: ied !< The ending i-index of the data domain at h. - integer :: jsd !< The starting j-index of the data domain at h. - integer :: jed !< The ending j-index of the data domain at h. integer :: num_col !< The number of sponge points within the computational domain. integer :: fldno = 0 !< The number of fields which have already been !! registered by calls to set_up_sponge_field @@ -80,11 +72,10 @@ module MOM_sponge contains -!> 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. +!> 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_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 @@ -104,8 +95,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & !! damp the zonal mean heights [Z ~> m]. -! 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_sponge" ! This module's name. logical :: use_sponge integer :: i, j, k, col, total_sponge_cols @@ -134,8 +125,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & CS%do_i_mean_sponge = present(Iresttime_i_mean) 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. CS%bulkmixedlayer = .false. @@ -203,13 +193,12 @@ subroutine init_sponge_diags(Time, G, GV, US, diag, CS) CS%diag => diag CS%id_w_sponge = register_diag_field('ocean_model', 'w_sponge', diag%axesTi, & - Time, 'The diapycnal motion due to the sponges', 'm s-1', conversion=US%s_to_T) + Time, 'The diapycnal motion due to the sponges', 'm s-1', conversion=GV%H_to_m*US%s_to_T) 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. +!> 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, 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 @@ -261,8 +250,8 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Ref_val_im(CS%fldno)%p(CS%jsd:CS%jed,CS%nz), source=0.0) - do k=1,CS%nz ; do j=CS%jsc,CS%jec + allocate(CS%Ref_val_im(CS%fldno)%p(G%jsd:G%jed,CS%nz), source=0.0) + do k=1,CS%nz ; do j=G%jsc,G%jec CS%Ref_val_im(CS%fldno)%p(j,k) = sp_val_i_mean(j,k) enddo ; enddo endif @@ -278,16 +267,10 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) intent(in) :: sp_val !< The reference values of the mixed layer density [R ~> kg m-3] type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that is !! set by a previous call to initialize_sponge. + ! The contents of this structure are intent(inout) here. real, dimension(SZJ_(G)), & optional, intent(in) :: sp_val_i_mean !< the reference values of the zonal mean mixed !! layer density [R ~> kg m-3], for use if Iresttime_i_mean > 0. -! This subroutine stores the reference value for mixed layer density. It is -! handled differently from other values because it is only used in determining -! which layers can be inflated. - -! Arguments: sp_val - The reference values of the mixed layer density. -! (in/out) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. integer :: j, col character(len=256) :: mesg ! String for error messages @@ -309,8 +292,8 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Rcv_ml_ref_im(CS%jsd:CS%jed), source=0.0) - do j=CS%jsc,CS%jec + allocate(CS%Rcv_ml_ref_im(G%jsd:G%jed), source=0.0) + do j=G%jsc,G%jec CS%Rcv_ml_ref_im(j) = sp_val_i_mean(j) enddo endif @@ -339,10 +322,6 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) real, dimension(SZI_(G),SZJ_(G)), & optional, intent(inout) :: Rcv_ml !< The coordinate density of the mixed layer [R ~> kg m-3]. -! This subroutine applies damping to the layers thicknesses, mixed -! layer buoyancy, and a variety of tracers for every column where -! there is damping. - ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, @@ -369,17 +348,18 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) 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 - ! heights in the two profiles to agree. + ! heights in the two profiles to agree [nondim]. real :: w ! The thickness of water moving upward through an ! interface within 1 timestep [H ~> m or kg m-2]. real :: wm ! wm is w if w is negative and 0 otherwise [H ~> m or kg m-2]. real :: wb ! w at the interface below a layer [H ~> m or kg m-2]. real :: wpb ! wpb is wb if wb is positive and 0 otherwise [H ~> m or kg m-2]. - real :: ea_k, eb_k ! [H ~> m or kg m-2] - real :: damp ! The timestep times the local damping coefficient [nondim]. + real :: ea_k ! Water entrained from above within a timestep [H ~> m or kg m-2] + real :: eb_k ! Water entrained from below within a timestep [H ~> m or kg m-2] + real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim] 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]. + real :: Idt ! The inverse of the timestep [T-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 = GV%ke @@ -575,7 +555,7 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then if (CS%id_w_sponge > 0) then - Idt = GV%H_to_m / dt ! Do any height unit conversion here for efficiency. + Idt = 1.0 / dt do k=1,nz+1 ; do j=js,je ; do i=is,ie w_int(i,j,K) = w_int(i,j,K) * Idt ! Scale values by clobbering array since it is local enddo ; enddo ; enddo From 6feadd083b7d7260d30bd0224a1e405c33a61b6c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Dec 2021 08:03:41 -0500 Subject: [PATCH 109/138] Use G%Rad_Earth_L in mct and NUOPC cap code Modified the two lines where the mct and NUOPC caps were using G%Rad_Earth to instead use G%Rad_Earth_L, and cancelled out the dimensional rescaling factors on these lines that are no longer appropriate. All answers should be bitwise identical, but because this change is to code that is not routinely exercised by testing with MOM6-examples, extra care should be taken in assessing these changes. --- config_src/drivers/mct_cap/ocn_comp_mct.F90 | 2 +- config_src/drivers/nuopc_cap/mom_cap.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/mct_cap/ocn_comp_mct.F90 b/config_src/drivers/mct_cap/ocn_comp_mct.F90 index 1872fff335..2f7deaa716 100644 --- a/config_src/drivers/mct_cap/ocn_comp_mct.F90 +++ b/config_src/drivers/mct_cap/ocn_comp_mct.F90 @@ -722,7 +722,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) call mct_gGrid_importRattr(dom_ocn,"lat",data,lsize) k = 0 - L2_to_rad2 = grid%US%L_to_m**2 / grid%Rad_Earth**2 + L2_to_rad2 = 1.0 / grid%Rad_Earth_L**2 do j = grid%jsc, grid%jec do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index ee498f4184..857505867c 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -1111,7 +1111,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) k = k + 1 ! Increment position within gindex if (mask(k) /= 0) then mesh_areas(k) = dataPtr_mesh_areas(k) - model_areas(k) = ocean_grid%US%L_to_m**2 * ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth**2 + model_areas(k) = ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth_L**2 mod2med_areacor(k) = model_areas(k) / mesh_areas(k) med2mod_areacor(k) = mesh_areas(k) / model_areas(k) end if From bbb975393619e7b0fbad5d0279a770fc65763342 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Dec 2021 10:29:54 -0500 Subject: [PATCH 110/138] +Rescale some sea-surface height variables to [Z] Rescaled the units of four internal sea surface height or related variables in MOM.F90 and three sea surface height arguments to post_surface_dyn_diags and post_surface_thermo_diags from [m] to [Z ~> m]. Also added a few comments describing variables in MOM_diagnostics.F90. All answers, diagnostics, and output are bitwise identical. --- src/core/MOM.F90 | 34 ++++++++++++++---------- src/diagnostics/MOM_diagnostics.F90 | 40 +++++++++++++++++------------ 2 files changed, 45 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0e036d9d8f..db114ac3fa 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -188,10 +188,10 @@ module MOM vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint - !< A running time integral of the sea surface height [T m ~> s m]. + !< A running time integral of the sea surface height [T Z ~> s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc !< time-averaged (over a forcing time step) sea surface height - !! with a correction for the inverse barometer [m] + !! with a correction for the inverse barometer [Z ~> m] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc !< free surface height or column mass time averaged over the last !! baroclinic dynamics time step [H ~> m or kg m-2] @@ -515,7 +515,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. real :: cycle_time ! The length of the coupled time-stepping cycle [T ~> s]. real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & - ssh ! sea surface height, which may be based on eta_av [m] + ssh ! sea surface height, which may be based on eta_av [Z ~> m] real, dimension(:,:,:), pointer :: & u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] @@ -868,7 +868,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, dZref=G%Z_ref) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -2867,11 +2867,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif - if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then + if (query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z /= US%m_to_Z_restart) ) then + Z_rescale = US%m_to_Z / US%m_to_Z_restart + do j=js,je ; do i=is,ie + CS%ave_ssh_ibc(i,j) = Z_rescale * CS%ave_ssh_ibc(i,j) + enddo ; enddo + endif + else if (CS%split) then - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, dZref=G%Z_ref) else - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, dZref=G%Z_ref) endif endif if (CS%split) deallocate(eta) @@ -2977,7 +2984,7 @@ subroutine register_diags(Time, G, GV, US, IDs, diag) 'Layer Thickness after the dynamics update', thickness_units, conversion=GV%H_to_MKS, & v_extensive=.true.) IDs%id_ssh_inst = register_diag_field('ocean_model', 'SSH_inst', diag%axesT1, & - Time, 'Instantaneous Sea Surface Height', 'm') + Time, 'Instantaneous Sea Surface Height', 'm', conversion=US%Z_to_m) end subroutine register_diags !> Set up CPU clock IDs for timing various subroutines. @@ -3097,14 +3104,14 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) 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)), intent(inout) :: ssh !< time mean surface height [m] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height [Z ~> m] real, dimension(:,:), pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa] logical, intent(in) :: use_EOS !< If true, calculate the density for !! the SSH correction using the equation of state. real :: Rho_conv(SZI_(G)) ! The density used to convert surface pressure to ! a corrected effective SSH [R ~> kg m-3]. - real :: IgR0 ! The SSH conversion factor from R L2 T-2 to m [m T2 R-1 L-2 ~> m Pa-1]. + real :: IgR0 ! The SSH conversion factor from R L2 T-2 to Z [Z T2 R-1 L-2 ~> m Pa-1]. logical :: calc_rho integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je @@ -3119,12 +3126,13 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, & tv%eqn_of_state, EOSdom) do i=is,ie - IgR0 = US%Z_to_m / (Rho_conv(i) * GV%g_Earth) + IgR0 = 1.0 / (Rho_conv(i) * GV%g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo else + IgR0 = 1.0 / (GV%Rho0 * GV%g_Earth) do i=is,ie - ssh(i,j) = ssh(i,j) + p_atm(i,j) * (US%Z_to_m / (GV%Rho0 * GV%g_Earth)) + ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo endif enddo @@ -3209,7 +3217,7 @@ subroutine extract_surface_state(CS, sfc_state_in) sfc_state%S_is_absS = CS%tv%S_is_absS do j=js,je ; do i=is,ie - sfc_state%sea_lev(i,j) = US%m_to_Z*CS%ave_ssh_ibc(i,j) + sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j) enddo ; enddo if (allocated(sfc_state%frazil) .and. associated(CS%tv%frazil)) then ; do j=js,je ; do i=is,ie diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index e06cb235c4..8d667503d7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -209,18 +209,23 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! tmp array for surface properties - real :: surface_field(SZI_(G),SZJ_(G)) + real :: surface_field(SZI_(G),SZJ_(G)) ! The surface temperature or salinity [degC] or [ppt] real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS [R L2 T-2 ~> Pa] - real :: wt, wt_p - + real :: wt, wt_p ! The fractional weights of two successive values when interpolating from + ! a list [nondim], scaled so that wt + wt_p = 1. real :: f2_h ! Squared Coriolis parameter at to h-points [T-2 ~> s-2] real :: mag_beta ! Magnitude of the gradient of f [T-1 L-1 ~> s-1 m-1] real :: absurdly_small_freq2 ! Frequency squared used to avoid division by 0 [T-2 ~> s-2] integer :: k_list - real, dimension(SZK_(GV)) :: temp_layer_ave, salt_layer_ave - real :: thetaoga, soga, masso, tosga, sosga + real, dimension(SZK_(GV)) :: temp_layer_ave ! The average temperature in a layer [degC] + real, dimension(SZK_(GV)) :: salt_layer_ave ! The average salinity in a layer [degC] + real :: thetaoga ! The volume mean potential temperature [degC] + real :: soga ! The volume mean ocean salinity [ppt] + real :: masso ! The total mass of the ocean [kg] + real :: tosga ! The area mean sea surface temperature [degC] + real :: sosga ! The area mean sea surface salinity [ppt] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -437,7 +442,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do j=js,je ; do i=is,ie surface_field(i,j) = tv%T(i,j,1) enddo ; enddo - tosga = global_area_mean(surface_field, G) + tosga = global_area_mean(tv%T(:,:,1), G) call post_data(CS%id_tosga, tosga, CS%diag) endif @@ -1240,7 +1245,8 @@ subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh) type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: speed ! The surface speed [L T-1 ~> m s-1] @@ -1280,23 +1286,25 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, intent(in) :: dt_int !< total time step associated with these diagnostics [T ~> s]. type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections - !! for ice displacement and the inverse barometer [m] + !! for ice displacement and the inverse barometer [Z ~> m] real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array real, dimension(SZI_(G),SZJ_(G)) :: & zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh [m] real :: I_time_int ! The inverse of the time interval [T-1 ~> s-1]. - real :: zos_area_mean, volo, ssh_ga + real :: zos_area_mean ! Global area mean sea surface height [m] + real :: volo ! Total volume of the ocean [m3] + real :: ssh_ga ! Global ocean area weighted mean sea seaface height [m] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ! area mean SSH if (IDs%id_ssh_ga > 0) then - ssh_ga = global_area_mean(ssh, G) + ssh_ga = global_area_mean(ssh, G, scale=US%Z_to_m) call post_data(IDs%id_ssh_ga, ssh_ga, diag) endif @@ -1306,7 +1314,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv if (IDs%id_zos > 0 .or. IDs%id_zossq > 0) then zos(:,:) = 0.0 do j=js,je ; do i=is,ie - zos(i,j) = ssh_ibc(i,j) + zos(i,j) = US%Z_to_m*ssh_ibc(i,j) enddo ; enddo zos_area_mean = global_area_mean(zos, G) do j=js,je ; do i=is,ie @@ -1324,9 +1332,9 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + US%Z_to_m*G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j) * (ssh(i,j) + G%bathyT(i,j)) enddo ; enddo - volo = global_area_integral(work_2d, G) + volo = global_area_integral(work_2d, G, scale=US%Z_to_m) call post_data(IDs%id_volo, volo, diag) endif @@ -1841,7 +1849,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) standard_name='square_of_sea_surface_height_above_geoid', & long_name='Square of sea surface height above geoid', units='m2') IDs%id_ssh = register_diag_field('ocean_model', 'SSH', diag%axesT1, Time, & - 'Sea Surface Height', 'm') + 'Sea Surface Height', 'm', conversion=US%Z_to_m) IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag,& long_name='Area averaged sea surface height', units='m', & standard_name='area_averaged_sea_surface_height') From 86eb106ac0be403986ffbb64376fb8f7319f84f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Dec 2021 05:32:23 -0500 Subject: [PATCH 111/138] Correct the units in two comments Corrected the reported unit conversions in two comments describing variables in MOM_offline_aux.F90. All answers and output are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index f95f2cd40e..b5d9c38fac 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -144,8 +144,8 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! top [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net downward fluxes through the layer ! bottom [H ~> m or kg m-2] - real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg m-2] - real :: hvol ! Cell volume [H L2 ~> m3 or kg m-2] + real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg] + real :: hvol ! Cell volume [H L2 ~> m3 or kg] real :: scale_factor ! A nondimensional rescaling factor between 0 and 1 [nondim] real :: max_off_cfl ! The maximum permitted fraction that can leave in a timestep [nondim] integer :: i, j, k, m, is, ie, js, je, nz From 049241ce1622355fe7f1639294fc06deafd061b1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 05:22:10 -0500 Subject: [PATCH 112/138] +Rescaled optics%opacity_band Rescaled the units of optics%opacity_band from [m-1] to [Z-1 ~> m-1], with the opacity values returned from extract_optics_slice also rescaled by the same factor, which can be offset by compensating changes to the opacity_scale argument. Also rescaled 4 other internal variables and documented the units on 3 more. One uncommon parameter (SW_1ST_EXP_RATIO) listed the wrong units in its get_param call, and this was corrected, but turned out not to have been logged for any of the MOM6-examples test cases. Some compensating changes were also made in the MOM_generic_tracer module, which directly accesses the contents of the optics_type (thereby preventing it from being opaque). All answers and output in the MOM6-examples test suite are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 4 +- .../vertical/MOM_opacity.F90 | 56 +++++++++---------- src/tracer/MOM_generic_tracer.F90 | 23 ++++---- 4 files changed, 42 insertions(+), 43 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 046329523d..926eaaa013 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -424,7 +424,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) enddo ; enddo - if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_m) + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_Z) do k=1,nz ; do i=is,ie d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 312d114dde..b0ca5a931e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1105,7 +1105,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom_H, 1.E-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, 1.0e-30*GV%m_to_H) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. @@ -1160,7 +1160,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Nothing more is done on this j-slice if there is no buoyancy forcing. if (.not.associated(fluxes%sw)) cycle - if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%m_to_H)) + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%Z_to_H)) ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index a99524060b..658170beda 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -25,7 +25,7 @@ module MOM_opacity type, public :: optics_type integer :: nbands !< The number of penetrating bands of SW radiation - real, allocatable :: opacity_band(:,:,:,:) !< SW optical depth per unit thickness [m-1] + real, allocatable :: opacity_band(:,:,:,:) !< SW optical depth per unit thickness [Z-1 ~> m-1] !! The number of radiation bands is most rapidly varying (first) index. real, allocatable :: sw_pen_band(:,:,:) !< shortwave radiation [Q R Z T-1 ~> W m-2] @@ -55,15 +55,15 @@ module MOM_opacity !! water properties into the opacity (i.e., the e-folding depth) and !! (perhaps) the number of bands of penetrating shortwave radiation to use. real :: pen_sw_scale !< The vertical absorption e-folding depth of the - !! penetrating shortwave radiation [m]. + !! penetrating shortwave radiation [Z ~> m]. real :: pen_sw_scale_2nd !< The vertical absorption e-folding depth of the - !! (2nd) penetrating shortwave radiation [m]. - real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity + !! (2nd) penetrating shortwave radiation [Z ~> m]. + real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity [nondim] real :: pen_sw_frac !< The fraction of shortwave radiation that is - !! penetrating with a constant e-folding approach. + !! penetrating with a constant e-folding approach [nondim] real :: blue_frac !< The fraction of the penetrating shortwave !! radiation that is in the blue band [nondim]. - real :: opacity_land_value !< The value to use for opacity over land [m-1]. + real :: opacity_land_value !< The value to use for opacity over land [Z-1 ~> m-1]. !! The default is 10 m-1 - a value for muddy water. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -107,15 +107,15 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ ! Local variables integer :: i, j, k, n, is, ie, js, je, nz - real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. + real :: inv_sw_pen_scale ! The inverse of the e-folding scale [Z-1 ~> m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating ! shortwave radiation [nondim] logical :: call_for_surface ! if horizontal slice is the surface layer - real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. + real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array for diagnosing opacity [Z-1 ~> m-1] real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [Q R Z T-1 ~> W m-2]. - real :: op_diag_len ! A tiny lengthscale [m] used to remap opacity + real :: op_diag_len ! A tiny lengthscale [Z ~> m] used to remap diagnostics of opacity ! from op to 1/op_diag_len * tanh(op * op_diag_len) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -128,14 +128,14 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif ! Make sure there is no division by 0. - inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_m, & - GV%H_to_m*GV%H_subroundoff) + inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_Z, & + GV%H_to_Z*GV%H_subroundoff) if ( CS%Opacity_scheme == DOUBLE_EXP ) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & - 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) + 0.1*GV%Angstrom_Z, GV%H_to_Z*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) @@ -199,7 +199,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ call post_data(CS%id_sw_vis_pen, Pen_SW_tot, CS%diag) endif do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then - op_diag_len = 1e-10 ! A dimensional depth to constrain the range of opacity [m] + op_diag_len = 1.0e-10*US%m_to_Z ! A minimal extinction depth to constrain the range of opacity [Z ~> m] !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie ! Remap opacity (op) to 1/L * tanh(op * L) where L is one Angstrom. @@ -375,18 +375,18 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir enddo else ! Band 1 is Manizza blue. - optics%opacity_band(1,i,j,k) = 0.0232 + 0.074*chl_data(i,j)**0.674 + optics%opacity_band(1,i,j,k) = (0.0232 + 0.074*chl_data(i,j)**0.674) * US%Z_to_m if (nbands >= 2) & ! Band 2 is Manizza red. - optics%opacity_band(2,i,j,k) = 0.225 + 0.037*chl_data(i,j)**0.629 + optics%opacity_band(2,i,j,k) = (0.225 + 0.037*chl_data(i,j)**0.629) * US%Z_to_m ! All remaining bands are NIR, for lack of something better to do. - do n=3,nbands ; optics%opacity_band(n,i,j,k) = 2.86 ; enddo + do n=3,nbands ; optics%opacity_band(n,i,j,k) = 2.86*US%Z_to_m ; enddo endif enddo ; enddo case (MOREL_88) do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = CS%opacity_land_value if (G%mask2dT(i,j) > 0.5) & - optics%opacity_band(1,i,j,k) = opacity_morel(chl_data(i,j)) + optics%opacity_band(1,i,j,k) = US%Z_to_m * opacity_morel(chl_data(i,j)) do n=2,optics%nbands optics%opacity_band(n,i,j,k) = optics%opacity_band(1,i,j,k) @@ -460,7 +460,8 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_ 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(max(optics%nbands,1),SZI_(G),SZK_(GV)), & - optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer + optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer [Z-1 ~> m-1], + !! but with units that can be altered by opacity_scale. real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. real, dimension(max(optics%nbands,1),SZI_(G)), & optional, intent(out) :: penSW_top !< The shortwave radiation [Q R Z T-1 ~> W m-2] @@ -866,7 +867,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & if (h(i,k) > 0.0) then do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k)*GV%H_to_m * optics%opacity_band(n,i,j,k) + opt_depth = h(i,k)*GV%H_to_Z * optics%opacity_band(n,i,j,k) exp_OD = exp(-opt_depth) SW_trans = exp_OD @@ -1015,19 +1016,18 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) call MOM_mesg('opacity_init: opacity scheme set to "'//trim(tmpstr)//'".', 5) endif call get_param(param_file, mdl, "PEN_SW_SCALE", CS%pen_sw_scale, & - "The vertical absorption e-folding depth of the "//& - "penetrating shortwave radiation.", units="m", default=0.0) + "The vertical absorption e-folding depth of the penetrating shortwave radiation.", & + units="m", default=0.0, scale=US%m_to_Z) !BGR/ Added for opacity_scheme==double_exp read in 2nd exp-decay and fraction if (CS%Opacity_scheme == DOUBLE_EXP ) then call get_param(param_file, mdl, "PEN_SW_SCALE_2ND", CS%pen_sw_scale_2nd, & "The (2nd) vertical absorption e-folding depth of the "//& - "penetrating shortwave radiation "//& - "(use if SW_EXP_MODE==double.)",& - units="m", default=0.0) + "penetrating shortwave radiation (use if SW_EXP_MODE==double.)", & + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "SW_1ST_EXP_RATIO", CS%sw_1st_exp_ratio, & "The fraction of 1st vertical absorption e-folding depth "//& "penetrating shortwave radiation if SW_EXP_MODE==double.",& - units="m", default=0.0) + units="nondim", default=0.0) elseif (CS%OPACITY_SCHEME == Single_Exp) then !/Else disable 2nd_exp scheme CS%pen_sw_scale_2nd = 0.0 @@ -1094,12 +1094,12 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) call get_param(param_file, mdl, "OPACITY_LAND_VALUE", CS%opacity_land_value, & "The value to use for opacity over land. The default is "//& - "10 m-1 - a value for muddy water.", units="m-1", default=10.0) + "10 m-1 - a value for muddy water.", units="m-1", default=10.0, scale=US%Z_to_m) CS%warning_issued = .false. if (.not.allocated(optics%opacity_band)) & - allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) + allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz), source=0.0) if (.not.allocated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) allocate(CS%id_opacity(optics%nbands), source=-1) @@ -1114,7 +1114,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) longname = 'Opacity for shortwave radiation in band '//trim(adjustl(bandnum)) & // ', saved as L^-1 tanh(Opacity * L) for L = 10^-10 m' CS%id_opacity(n) = register_diag_field('ocean_model', shortname, diag%axesTL, Time, & - longname, 'm-1') + longname, 'm-1', conversion=US%m_to_Z) enddo end subroutine opacity_init diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 4627d0ec80..fbde0dc04e 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -54,7 +54,7 @@ module MOM_generic_tracer implicit none ; private - !> An state hidden in module data that is very much not allowed in MOM6 + !> A state hidden in module data that is very much not allowed in MOM6 ! ### This needs to be fixed logical :: g_registered = .false. @@ -83,13 +83,8 @@ module MOM_generic_tracer !> 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 - end type MOM_generic_tracer_CS -! This include declares and sets the variable "version". -#include "version_variable.h" - contains !> Initializes the generic tracer packages and adds their tracers to the list @@ -104,9 +99,12 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) !! advection and diffusion module. type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct -! Local variables + ! Local variables logical :: register_MOM_generic_tracer + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=128), parameter :: sub_name = 'register_MOM_generic_tracer' character(len=200) :: inputdir ! The directory where NetCDF input files are. ! These can be overridden later in via the field manager? @@ -381,8 +379,6 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, call g_tracer_set_csdiag(CS%diag) #endif - CS%H_to_m = GV%H_to_m - end subroutine initialize_MOM_generic_tracer !> Column physics for generic tracers. @@ -503,7 +499,8 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! !Calculate tendencies (i.e., field changes at dt) from the sources / sinks ! - if ((G%US%L_to_m == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0) .and. (G%US%s_to_T == 1.0)) then + if ((G%US%L_to_m == 1.0) .and. (G%US%s_to_T == 1.0) .and. (G%US%Z_to_m == 1.0) .and. & + (G%US%Q_to_J_kg == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0)) then ! Avoid unnecessary copies when no unit conversion is needed. call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%areaT, get_diag_time_end(CS%diag), & @@ -512,7 +509,9 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, else call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & - optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & + optics%nbands, optics%max_wavelength_band, & + sw_pen_band=G%US%QRZ_T_to_W_m2*optics%sw_pen_band(:,:,:), & + opacity_band=G%US%m_to_Z*optics%opacity_band(:,:,:,:), & internal_heat=G%US%RZ_to_kg_m2*tv%internal_heat(:,:), & frunoff=G%US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) endif @@ -864,7 +863,7 @@ subroutine MOM_generic_tracer_surface_state(sfc_state, h, G, GV, CS) !nnz: fake rho0 rho0=1.0 - dzt(:,:,:) = CS%H_to_m * h(:,:,:) + dzt(:,:,:) = GV%H_to_m * h(:,:,:) sosga = global_area_mean(sfc_state%SSS, G) From 0544f9f2e31eec2e14f98720700a993907cf5ab8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 06:50:29 -0500 Subject: [PATCH 113/138] +(*)Avoid segmentation faults if PEN_SW_NBANDS = 0 Modified three routines in MOM_opacity to avoid segmentation faults if PEN_SW_NBANDS = 0, and hence if the optics type is not being allocated. In the case of optics_nbands(), this involved formally changing an optics_type argument into a pointer to an optics_type. (Pointers to an optics_type were already been used as the argument in all calls to optics_nbands(), but it was not always associated.) In two other routines, the change is simply to add a return call if there are 0 bands of shortwave radiation. With these changes, the single column test cases with no penetrating shortwave radiation now successfully run if PEN_SW_NBANDS = 0 and give answers that are identical to those obtained with PEN_SW_NBANDS = 1. All answers and output in cases that ran previously are bitwise identical, but there is a subtle change in a public interface. --- .../vertical/MOM_opacity.F90 | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 658170beda..9aa8fafd14 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -503,11 +503,15 @@ end subroutine extract_optics_fields !> Return the number of bands of penetrating shortwave radiation. function optics_nbands(optics) - type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + type(optics_type), pointer :: optics !< An optics structure that has values of opacities !! and shortwave fluxes. integer :: optics_nbands !< The number of penetrating bands of SW radiation - optics_nbands = optics%nbands + if (associated(optics)) then + optics_nbands = optics%nbands + else + optics_nbands = 0 + endif end function optics_nbands !> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inherited @@ -617,8 +621,10 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! TKE budget of the shortwave heating. real :: C1_6, C1_60 integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. + if (nsw < 1) return + + SW_Remains = .false. min_SW_heat = optics%PenSW_flux_absorb * dt I_Habs = optics%PenSW_absorb_Invlen @@ -842,12 +848,16 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H 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 = GV%ke + if (nsw < 1) then + netPen(:,:) = 0.0 + return + endif + pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) do i=is,ie ; h_heat(i) = 0.0 ; enddo do i=is,ie @@ -859,6 +869,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & ! Apply penetrating SW radiation to remaining parts of layers. ! Excessively thin layers are not heated to avoid runaway temps. + min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H do k=1,nz do i=is,ie From 50df270e87c40ad861c8d65cde6de9b53de6cf2f Mon Sep 17 00:00:00 2001 From: OlgaSergienko <39838355+OlgaSergienko@users.noreply.github.com> Date: Fri, 17 Dec 2021 17:33:09 -0500 Subject: [PATCH 114/138] Ice dynamics (#35) * In MOM_ice_shelf_dynamics.F90 changes are made to calc_shelf_visc() and calc_shelf_driving_stress() to account for an irregular quadrilateral grid. In MOM_ice_shelf_initialize.F90 changes are made to initialize_ice_thickness_from_file() to correct masks at initialization. * Changed indentation * Changes are made to 'calc_shelf_visc()` to make computations of the velocity derivatives rotation-invariant. Changes in `update_ice_shelf()` utilize G%IareaT(:,:) instead of 1/G%areaT(:,:). --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 118 ++++++++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 45 ++++---- 2 files changed, 99 insertions(+), 64 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index df2e801613..8fb674e36c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -260,9 +260,9 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0 ) ! [degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) - allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Units?] + allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3s-1] allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) - allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Units?] + allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding] allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) @@ -553,8 +553,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE) call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE) - !initialize ice flow velocities from file - call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, ISS%hmask,ISS%h_shelf, & + !initialize ice flow characteristic (velocities, bed elevation under the grounded part, etc) from file + call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, & G, US, param_file) call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) call pass_var(CS%bed_elev, G%domain,CENTER) @@ -567,9 +567,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) ! I think that the conversion factors for the next two diagnostics are wrong. - RWH CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesB1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) + 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%RL2_T2_to_Pa) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesB1, Time, & - 'y-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) + 'y-driving stress of ice', 'kPa', conversion=1.e-3*US%RL2_T2_to_Pa) CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesB1, Time, & 'mask for u-nodes', 'none') CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesB1, Time, & @@ -579,9 +579,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & - 'viscosity', 'm', conversion=1e-6*US%Z_to_m) + 'vi-viscosity', 'Pa s-1 m', conversion=US%RL2_T2_to_Pa*US%L_T_to_m_s) !vertically integrated viscosity CS%id_taub = register_diag_field('ice_shelf_model','taub_beta',CS%diag%axesT1, Time, & - 'taub', 'Pa yr m-1', conversion=1e-6*US%Z_to_m) + 'taub', 'MPa', conversion=1e-6*US%RL2_T2_to_Pa) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) endif @@ -673,7 +673,10 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is !! determined by coupled ice-ocean dynamics logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. - + real, dimension(SZDIB_(G),SZDJB_(G)) ::taud_x,taud_y ! Pa] + real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc ! Pa s-1 m] + real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr ! Pa] integer :: iters logical :: update_ice_vel, coupled_GL @@ -706,12 +709,24 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) ! if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) - if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) + if (CS%id_taudx_shelf > 0) then + taud_x(:,:) = CS%taudx_shelf(:,:)*G%IareaT(:,:) + call post_data(CS%id_taudx_shelf,taud_x , CS%diag) + endif + if (CS%id_taudy_shelf > 0) then + taud_y(:,:) = CS%taudy_shelf(:,:)*G%IareaT(:,:) + call post_data(CS%id_taudy_shelf,taud_y , CS%diag) + endif if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) - if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) - if (CS%id_taub > 0) call post_data(CS%id_taub, CS%basal_traction,CS%diag) + if (CS%id_visc_shelf > 0) then + ice_visc(:,:)=CS%ice_visc(:,:)*G%IareaT(:,:) + call post_data(CS%id_visc_shelf, ice_visc,CS%diag) + endif + if (CS%id_taub > 0) then + basal_tr(:,:) = CS%basal_traction(:,:)*G%IareaT(:,:) + call post_data(CS%id_taub, basal_tr,CS%diag) + endif !! if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -874,6 +889,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) > 0) then float_cond(i,j) = 1.0 CS%ground_frac(i,j) = 1.0 + CS%OD_av(i,j) =0.0 endif enddo enddo @@ -960,7 +976,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i !! begin loop - do iter=1,100 + do iter=1,50 call ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) @@ -1775,7 +1791,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) intent(inout) :: taudx !< X-direction driving stress at q-points [kg L s-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: taudy !< Y-direction driving stress at q-points [kg L s-2 ~> kg m s-2] - ! This will become [R L3 Z T-2 ~> kg m s-2] + ! This will become [R L3 Z T-2 ~> kg m s-2] ! driving stress! @@ -1790,12 +1806,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation [Z ~> m]. BASE ! basal elevation of shelf/stream [Z ~> m]. + real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian + ! quadrature points surrounding the cell vertices [m-1]. real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> nondim] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] - real :: dxh, dyh ! Local grid spacing [L ~> m] + real :: dxh, dyh,Dx,Dy ! Local grid spacing [L ~> m] real :: grav ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq @@ -1813,6 +1831,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset + rho = CS%density_ice rhow = CS%density_ocean_avg grav = CS%g_Earth @@ -1821,13 +1840,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! or is this faster? BASE(:,:) = -CS%bed_elev(:,:) + OD(:,:) - S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) - + S(:,:) = -CS%bed_elev(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded do j=jsc-G%domain%njhalo,jec+G%domain%njhalo do i=isc-G%domain%nihalo,iec+G%domain%nihalo if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j) + else + S(i,j)=ISS%h_shelf(i,j)-CS%bed_elev(i,j) endif enddo enddo @@ -1838,7 +1858,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) sy = 0 dxh = G%dxT(i,j) dyh = G%dyT(i,j) - + Dx=dxh + Dy=dyh if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell ! calculate sx @@ -1857,12 +1878,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) else ! interior if (ISS%hmask(i+1,j) == 1) then cnt = cnt+1 + Dx =dxh+ G%dxT(i+1,j) sx = S(i+1,j) else sx = S(i,j) endif if (ISS%hmask(i-1,j) == 1) then cnt = cnt+1 + Dx =dxh+ G%dxT(i-1,j) sx = sx - S(i-1,j) else sx = sx - S(i,j) @@ -1870,7 +1893,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (cnt == 0) then sx = 0 else - sx = sx / (cnt * dxh) + sx = sx / ( Dx) endif endif @@ -1892,6 +1915,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) else ! interior if (ISS%hmask(i,j+1) == 1) then cnt = cnt+1 + Dy =dyh+ G%dyT(i,j+1) sy = S(i,j+1) else sy = S(i,j) @@ -1899,13 +1923,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (ISS%hmask(i,j-1) == 1) then cnt = cnt+1 sy = sy - S(i,j-1) + Dy =dyh+ G%dyT(i,j-1) else sy = sy - S(i,j) endif if (cnt == 0) then sy = 0 else - sy = sy / (cnt * dyh) + sy = sy / (Dy) endif endif @@ -1930,10 +1955,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif if (CS%ground_frac(i,j) == 1) then -! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2) +! neumann_val = (.5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2)) neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else - neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 + neumann_val = (.5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2) endif if ((CS%u_face_mask(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then @@ -1971,7 +1996,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) endif enddo enddo - end subroutine calc_shelf_driving_stress subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) @@ -2528,8 +2552,8 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) end subroutine apply_boundary_values + !> Update depth integrated viscosity, based on horizontal strain rates, and also update the -!! nonlinear part of the basal traction. subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe @@ -2540,9 +2564,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) intent(inout) :: u_shlf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(inout) :: v_shlf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. - + real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian + ! quadrature points surrounding the cell vertices [m-1]. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve -! so there is an "upper" and "lower" bilinear viscosity ! also this subroutine updates the nonlinear part of the basal traction @@ -2553,7 +2577,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) real :: Visc_coef, n_g real :: ux, uy, vx, vy real :: eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] - real, dimension(8,4) :: Phi +! real, dimension(8,4) :: Phi real, dimension(2) :: xquad ! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] @@ -2566,6 +2590,12 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset + allocate(Phi(1:8,1:4,isd:ied,jsd:jed), source=0.0) + + do j=jsc,jec ; do i=isc,iec + call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) + enddo ; enddo + n_g = CS%n_glen; eps_min = CS%eps_glen_min CS%ice_visc(:,:)=1e22 ! Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) @@ -2575,21 +2605,35 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%AGlen_visc(i,j))**(-1./CS%n_glen) - ux = ((u_shlf(I,J) + (u_shlf(I,J-1) + u_shlf(I,J+1))) - & - (u_shlf(I-1,J) + (u_shlf(I-1,J-1) + u_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) - vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & - (v_shlf(I-1,J) + (v_shlf(I-1,J-1) + v_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) - uy = ((u_shlf(I,J) + (u_shlf(I-1,J) + u_shlf(I+1,J))) - & - (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) - vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & - (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) + do iq=1,2 ; do jq=1,2 + + ux = ( (u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & + u_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + & + (u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + & + u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) ) + + vx = ( (v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & + v_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + & + (v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + & + v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) ) + + uy = ( (u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq,i,j) + & + u_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + & + (u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & + u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) + + vy = ( (v_shlf(I-1,j-1) * Phi(2,2*(jq-1)+iq,i,j) + & + v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + & + (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & + v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) + enddo ; enddo ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) endif enddo enddo - + deallocate(Phi) end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 469cba39ce..7cc3c020a3 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -149,14 +149,13 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U enddo ; enddo endif - if (len_sidestress > 0.) then do j=jsc,jec do i=isc,iec ! taper ice shelf in area where there is no sidestress - ! but do not interfere with hmask - if (G%geoLonCv(i,j) > len_sidestress) then + if ((len_sidestress > 0.) .and. (G%geoLonCv(i,j) > len_sidestress)) then udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) if (udh <= 25.0) then h_shelf(i,j) = 0.0 @@ -180,7 +179,6 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U endif enddo enddo - endif end subroutine initialize_ice_thickness_from_file !> Initialize ice shelf thickness for a channel configuration @@ -397,13 +395,13 @@ end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file -subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& - hmask,h_shelf, G, US, PF) -!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,ice_visc,float_cond,& +!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& ! hmask,h_shelf, G, US, PF) +subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& + G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: bed_elev !< The ice shelf u velocity [Z ~> m]. + intent(inout) :: bed_elev !< The bed elevation [Z ~> m]. real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & @@ -412,12 +410,12 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< A mask indicating which tracer points are +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(in) :: h_shelf !< A mask indicating which tracer points are +! !! partly or fully covered by an ice-shelf type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -453,10 +451,10 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& "The name of the thickness variable in ICE_VELOCITY_FILE.", & default="viscosity") call get_param(PF, mdl, "BED_TOPO_FILE", bed_topo_file, & - "The file from which the velocity is read.", & + "The file from which the bed elevation is read.", & default="ice_shelf_vel.nc") call get_param(PF, mdl, "BED_TOPO_VARNAME", bed_varname, & - "The name of the thickness variable in ICE_VELOCITY_FILE.", & + "The name of the thickness variable in ICE_INPUT_FILE.", & default="depth") if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) @@ -470,15 +468,8 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& filename = trim(inputdir)//trim(bed_topo_file) call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.) - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec +! isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec -! do j=jsc,jec -! do i=isc,iec -! if (hmask(i,j) == 1.) then -! ice_visc(i,j) = ice_visc(i,j) * (G%areaT(i,j) * h_shelf(i,j)) -! endif -! enddo -! enddo end subroutine initialize_ice_flow_from_file @@ -510,7 +501,7 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< Ice-shelf thickness + intent(in) :: h_shelf !< Ice-shelf thickness type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -535,9 +526,9 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask call get_param(PF, mdl, "ICE_THICKNESS_FILE", icethick_file, & "The file from which the ice-shelf thickness is read.", & default="ice_shelf_thick.nc") - call get_param(PF, mdl, "ICE_THICKNESS_VARNAME", h_varname, & - "The name of the thickness variable in ICE_THICKNESS_FILE.", & - default="h_shelf") +! call get_param(PF, mdl, "ICE_THICKNESS_VARNAME", h_varname, & +! "The name of the thickness variable in ICE_THICKNESS_FILE.", & +! default="h_shelf") call get_param(PF, mdl, "ICE_THICKNESS_MASK_VARNAME", hmsk_varname, & "The name of the icethickness mask variable in ICE_THICKNESS_FILE.", & default="h_mask") @@ -574,7 +565,7 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask call MOM_read_data(filename,trim(vmask_varname), vmask, G%Domain, position=CORNER,scale=1.) filename = trim(inputdir)//trim(icethick_file) - call MOM_read_data(filename, trim(h_varname), h_shelf, G%Domain, scale=US%m_to_Z) +! call MOM_read_data(filename, trim(h_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(hmsk_varname), hmask, G%Domain, scale=1.) isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec From 12f29f67abdc6a8afb783e50159b1d9ffe014692 Mon Sep 17 00:00:00 2001 From: wfcooke Date: Fri, 17 Dec 2021 21:48:53 -0500 Subject: [PATCH 115/138] Adding temperature restore capability for SPEAR. (#36) * Adding temperature restore capability for SPEAR. Added parameter SPEAR_ECDA_SST_RESTORE_TFREEZE to allow activation of sea surface salinity based modification of restoring of temperature. The formula used is different from the Millero (default in SPEAR runs) scheme. * removed spaces on blank line. * (*)Changed hard wired value to parameter defined in MOM_override The freezing temperature came from SIS2 code. Changing the default value here to be consistent with that. (-0.054 vs -0.0539) The salinity restoring code used the -0.0539 value also so answers may change if using that code (RESTORE_SALINITY=T) * (*)Changed hard wired value to parameter defined in MOM_override The freezing temperature came from SIS2 code. Changing the default value here to be consistent with that. (-0.054 vs -0.0539) The salinity restoring code used the -0.0539 value also so answers may change if using that code (RESTORE_SALINITY=T) * Forgot to replace the salinity masking mulitplier with the override parameter --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 09ba9e1156..cab870fed4 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -113,6 +113,8 @@ module MOM_surface_forcing_gfdl real :: Flux_const !< Piston velocity for surface restoring [Z T-1 ~> m s-1] real :: Flux_const_salt !< Piston velocity for surface salt restoring [Z T-1 ~> m s-1] real :: Flux_const_temp !< Piston velocity for surface temp restoring [Z T-1 ~> m s-1] + logical :: trestore_SPEAR_ECDA !< If true, modify restoring data wrt local SSS + real :: SPEAR_dTf_dS !< The derivative of the freezing temperature with salinity. logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux logical :: adjust_net_srestore_to_zero !< Adjust srestore to zero (for both salt_flux or vprec) logical :: adjust_net_srestore_by_scaling !< Adjust srestore w/o moving zero contour @@ -346,7 +348,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, open_ocn_mask(:,:) = 1.0 if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice do j=js,je ; do i=is,ie - if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + if (sfc_state%SST(i,j) <= CS%SPEAR_dTf_dS*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 enddo ; enddo endif if (CS%salt_restore_as_sflux) then @@ -400,6 +402,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! SST restoring logic if (CS%restore_temp) then call time_interp_external(CS%id_trestore, Time, data_restore) + if ( CS%trestore_SPEAR_ECDA ) then + do j=js,je ; do i=is,ie + if (abs(data_restore(i,j)+1.8)<0.0001) then + data_restore(i,j) = CS%SPEAR_dTf_dS*sfc_state%SSS(i,j) + endif + enddo ; enddo + endif + do j=js,je ; do i=is,ie delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) @@ -1448,7 +1458,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "If true, read a file (temp_restore_mask) containing "//& "a mask for SST restoring.", default=.false.) + call get_param(param_file, mdl, "SPEAR_ECDA_SST_RESTORE_TFREEZE", CS%trestore_SPEAR_ECDA, & + "If true, modify SST restoring field using SSS state. This only modifies the "//& + "restoring data that is within 0.0001degC of -1.8degC.", default=.false.) endif + call get_param(param_file, mdl, "SPEAR_DTFREEZE_DS", CS%SPEAR_dTf_dS, & + "The derivative of the freezing temperature with salinity.", & + units="deg C PSU-1", default=-0.054, do_not_log=.not.CS%trestore_SPEAR_ECDA) ! Optionally read tidal amplitude from input file [Z T-1 ~> m s-1] on model grid. ! Otherwise use default tidal amplitude for bottom frictionally-generated From a902e75845b38369bafdc9d0526300e5e8ff3bb0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Dec 2021 06:26:03 -0500 Subject: [PATCH 116/138] +Add US args and rescale dt arg to generic tracers Added unit_scaling_type arguments to various routines that had previously used a unit scaling type, but did so via the G%US pointer, to make the type dependencies more explicit and to avoid unnecessary pointer use. It had been the intention to make these arguments explicit from the time they were introduced via a pointer in the ocean_grid_type as a temporary convenience. The construct G%US%... was replaced with US%... wherever it was possible. Also rescaled some local variables or corrected comments in oil_tracer.F90, nw2_tracers.F90, and boundary_impulse_tracer.F90, and rescaled the units of the dt argument to MOM_generic_tracer_column_physics from [s] to [T ~> s]. All answers are bitwise identical, although there are multiple changes to public interfaces. --- src/core/MOM.F90 | 8 ++-- src/core/MOM_boundary_update.F90 | 4 +- src/core/MOM_variables.F90 | 10 ++-- src/diagnostics/MOM_sum_output.F90 | 11 +++-- .../MOM_state_initialization.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 48 +++++++++---------- src/tracer/MOM_CFC_cap.F90 | 5 +- src/tracer/MOM_OCMIP2_CFC.F90 | 5 +- src/tracer/MOM_generic_tracer.F90 | 32 +++++++------ src/tracer/MOM_tracer_Z_init.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 37 +++++++------- src/tracer/advection_test_tracer.F90 | 5 +- src/tracer/boundary_impulse_tracer.F90 | 27 ++++++----- src/tracer/dye_example.F90 | 5 +- src/tracer/ideal_age_example.F90 | 5 +- src/tracer/nw2_tracers.F90 | 32 +++++++------ src/tracer/oil_tracer.F90 | 28 ++++++----- src/tracer/pseudo_salt_tracer.F90 | 5 +- src/tracer/tracer_example.F90 | 5 +- src/user/dyed_channel_initialization.F90 | 5 +- src/user/shelfwave_initialization.F90 | 2 +- src/user/supercritical_initialization.F90 | 11 ++--- src/user/tidal_bay_initialization.F90 | 7 +-- 23 files changed, 163 insertions(+), 138 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index db114ac3fa..ea54aece44 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1214,7 +1214,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) @@ -1445,7 +1445,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) @@ -3514,7 +3514,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) @@ -3523,7 +3523,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) endif diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index 286cec20d4..11973f8c02 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -147,13 +147,13 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) ! if (CS%use_files) & ! call update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (CS%use_tidal_bay) & - call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC, G, GV, h, Time) + call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC, G, GV, US, 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, GV, US, h, Time) if (CS%use_dyed_channel) & - call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, Time) + call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, US, 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_variables.F90 b/src/core/MOM_variables.F90 index f61879845a..5de7ea7319 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -11,6 +11,7 @@ module MOM_variables use MOM_EOS, only : EOS_type use MOM_error_handler, only : MOM_error, FATAL use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -562,10 +563,11 @@ subroutine dealloc_BT_cont_type(BT_cont) end subroutine dealloc_BT_cont_type !> Diagnostic checksums on various elements of a thermo_var_ptrs type for debugging. -subroutine MOM_thermovar_chksum(mesg, tv, G) +subroutine MOM_thermovar_chksum(mesg, tv, G, US) character(len=*), intent(in) :: mesg !< A message that appears in the checksum lines type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! 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 @@ -575,11 +577,11 @@ subroutine MOM_thermovar_chksum(mesg, tv, G) if (associated(tv%S)) & call hchksum(tv%S, mesg//" tv%S", G%HI) if (associated(tv%frazil)) & - call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=G%US%RZ_to_kg_m2) + call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=US%RZ_to_kg_m2) if (associated(tv%TempxPmE)) & - call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=G%US%RZ_to_kg_m2) + call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=US%RZ_to_kg_m2) end subroutine MOM_thermovar_chksum end module MOM_variables diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 3b6fb0c510..668c297658 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -532,7 +532,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci nTr_stocks = 0 Tr_minmax_avail(:) = .false. - call call_tracer_stocks(h, Tr_stocks, G, GV, tracer_CSp, stock_names=Tr_names, & + call call_tracer_stocks(h, Tr_stocks, G, GV, US, tracer_CSp, stock_names=Tr_names, & stock_units=Tr_units, num_stocks=nTr_stocks,& got_min_max=Tr_minmax_avail, global_min=Tr_min, global_max=Tr_max, & xgmin=Tr_min_x, ygmin=Tr_min_y, zgmin=Tr_min_z,& @@ -1248,7 +1248,7 @@ subroutine write_depth_list(G, US, DL, filename) character(len=16) :: depth_chksum, area_chksum ! All ranks are required to compute the global checksum - call get_depth_list_checksums(G, depth_chksum, area_chksum) + call get_depth_list_checksums(G, US, depth_chksum, area_chksum) if (.not.is_root_pe()) return @@ -1313,7 +1313,7 @@ subroutine read_depth_list(G, US, DL, filename, require_chksum, file_matches) call MOM_error(WARNING, trim(var_msg) // " some diagnostics may not be reproducible.") endif else - call get_depth_list_checksums(G, depth_grid_chksum, area_grid_chksum) + call get_depth_list_checksums(G, US, depth_grid_chksum, area_grid_chksum) if ((trim(depth_grid_chksum) /= trim(depth_file_chksum)) .or. & (trim(area_grid_chksum) /= trim(area_file_chksum)) ) then @@ -1360,8 +1360,9 @@ end subroutine read_depth_list !! !! Checksums are saved as hexadecimal strings, in order to avoid potential !! datatype issues with netCDF attributes. -subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) +subroutine get_depth_list_checksums(G, US, depth_chksum, area_chksum) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=16), intent(out) :: depth_chksum !< Depth checksum hexstring character(len=16), intent(out) :: area_chksum !< Area checksum hexstring @@ -1378,7 +1379,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Area checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) + field(i,j) = G%mask2dT(i,j) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo write(area_chksum, '(Z16)') field_chksum(field(:,:)) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 2aab378b4a..8055440cce 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -620,7 +620,7 @@ 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, GV, PF) + call supercritical_set_OBC_data(OBC, G, GV, US, PF) elseif (trim(config) == "tidal_bay") then OBC%update_OBC = .true. elseif (trim(config) == "USER") then diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 77ec87b230..c123e60800 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -601,7 +601,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -678,7 +678,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) @@ -699,7 +699,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -747,7 +747,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ent_s, "after calc_entrain ent_s", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -842,7 +842,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_remap) if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G, US) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") @@ -851,7 +851,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) + call MOM_thermovar_chksum("after negative check ", tv, G, US) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) @@ -908,7 +908,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) endif ! Whenever thickness changes let the diag manager know, as the @@ -1020,7 +1020,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -1032,7 +1032,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd @@ -1185,7 +1185,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1253,7 +1253,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) @@ -1274,7 +1274,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -1372,7 +1372,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_remap) if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G, US) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") @@ -1439,7 +1439,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) endif ! Whenever thickness changes let the diag manager know, as the @@ -1526,7 +1526,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -1538,7 +1538,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd @@ -1789,7 +1789,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1863,7 +1863,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1896,7 +1896,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -1934,7 +1934,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) @@ -1985,7 +1985,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) + call MOM_thermovar_chksum("after negative check ", tv, G, US) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) @@ -2183,7 +2183,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif @@ -2331,7 +2331,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -2342,7 +2342,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 79df57cc23..7296f1d469 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -341,13 +341,14 @@ end subroutine CFC_cap_column_physics !> Calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) +function CFC_cap_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CFC_cap_CS), pointer :: CS !< The control structure returned by a !! previous call to register_CFC_cap. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -376,7 +377,7 @@ function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="CFC_cap_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 38193a3abc..5fe55b896b 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -478,13 +478,14 @@ end subroutine OCMIP2_CFC_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) +function OCMIP2_CFC_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -513,7 +514,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="OCMIP2_CFC_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 4627d0ec80..bf9f01e266 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -395,7 +395,7 @@ end subroutine initialize_MOM_generic_tracer !! tracer physics or chemistry to the tracers from this file. !! CFCs are relatively simple, as they are passive tracers. with only a surface !! flux as a source. - subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, CS, tv, optics, & + subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, CS, tv, optics, & 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 @@ -412,7 +412,8 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth [Z ~> m] - real, intent(in) :: dt !< The amount of time covered by this call [s] + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(optics_type), intent(in) :: optics !< The structure containing optical properties. @@ -469,7 +470,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, call g_tracer_get_pointer(g_tracer,g_tracer_name,'runoff_tracer_flux',runoff_tracer_flux_array) !nnz: Why is fluxes%river = 0? runoff_tracer_flux_array(:,:) = trunoff_array(:,:) * & - G%US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) + US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) stf_array = stf_array + runoff_tracer_flux_array endif @@ -496,25 +497,25 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dz_ml(:,:) = 0.0 do j=jsc,jec ; do i=isc,iec surface_field(i,j) = tv%S(i,j,1) - dz_ml(i,j) = G%US%Z_to_m * Hml(i,j) + dz_ml(i,j) = US%Z_to_m * Hml(i,j) enddo ; enddo sosga = global_area_mean(surface_field, G) ! !Calculate tendencies (i.e., field changes at dt) from the sources / sinks ! - if ((G%US%L_to_m == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0) .and. (G%US%s_to_T == 1.0)) then + if ((US%L_to_m == 1.0) .and. (US%RZ_to_kg_m2 == 1.0) .and. (US%s_to_T == 1.0)) then ! Avoid unnecessary copies when no unit conversion is needed. call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%areaT, get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) else - call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & - G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & + call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, US%T_to_s*dt, & + US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & - internal_heat=G%US%RZ_to_kg_m2*tv%internal_heat(:,:), & - frunoff=G%US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) + internal_heat=US%RZ_to_kg_m2*tv%internal_heat(:,:), & + frunoff=US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) endif ! This uses applyTracerBoundaryFluxesInOut to handle the change in tracer due to freshwater fluxes @@ -526,7 +527,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, do k=1,nk ;do j=jsc,jec ; do i=isc,iec h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), G%US%s_to_T*dt, & + call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), dt, & fluxes, h_work, evap_CFL_limit, minimum_forcing_depth) endif @@ -544,16 +545,16 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! surface source is applied and diapycnal advection and diffusion occurs. if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then ! Last arg is tau which is always 1 for MOM6 - call generic_tracer_vertdiff_G(h_work, ea, eb, dt, GV%kg_m2_to_H, GV%m_to_H, 1) + call generic_tracer_vertdiff_G(h_work, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1) else ! Last arg is tau which is always 1 for MOM6 - call generic_tracer_vertdiff_G(h_old, ea, eb, dt, GV%kg_m2_to_H, GV%m_to_H, 1) + call generic_tracer_vertdiff_G(h_old, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1) endif ! Update bottom fields after vertical processes ! Second arg is tau which is always 1 for MOM6 - call generic_tracer_update_from_bottom(dt, 1, get_diag_time_end(CS%diag)) + call generic_tracer_update_from_bottom(US%T_to_s*dt, 1, get_diag_time_end(CS%diag)) !Output diagnostics via diag_manager for all generic tracers and their fluxes call g_tracer_send_diag(CS%g_tracer_list, get_diag_time_end(CS%diag), tau=1) @@ -568,12 +569,13 @@ end subroutine MOM_generic_tracer_column_physics !! being requested specifically, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding !! to that coded index is returned. - function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) + function MOM_generic_tracer_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. @@ -604,7 +606,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde if (.NOT. associated(CS%g_tracer_list)) return ! No stocks. - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 m=1 ; g_tracer=>CS%g_tracer_list do call g_tracer_get_alias(g_tracer,names(m)) diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 1be976d3f2..e8324b6043 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -565,7 +565,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: temp !< potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt !< salinity [PSU] + intent(inout) :: salt !< salinity [ppt] 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 diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 4278594913..2ae72a3270 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -262,13 +262,13 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) register_pseudo_salt_tracer(HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_boundary_impulse_tracer) CS%use_boundary_impulse_tracer = & - register_boundary_impulse_tracer(HI, GV, param_file, CS%boundary_impulse_tracer_CSp, & + register_boundary_impulse_tracer(HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_dyed_obc_tracer) CS%use_dyed_obc_tracer = & register_dyed_obc_tracer(HI, GV, param_file, CS%dyed_obc_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_nw2_tracers) CS%use_nw2_tracers = & - register_nw2_tracers(HI, GV, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) + register_nw2_tracers(HI, GV, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) end subroutine call_tracer_register @@ -346,7 +346,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag call initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & sponge_CSp, tv) if (CS%use_boundary_impulse_tracer) & - call initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS%boundary_impulse_tracer_CSp, & + call initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS%boundary_impulse_tracer_CSp, & sponge_CSp, tv) if (CS%use_dyed_obc_tracer) & call initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS%dyed_obc_tracer_CSp) @@ -495,8 +495,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & - G, GV, CS%MOM_generic_tracer_CSp, tv, optics, & + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) endif @@ -555,8 +555,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & - G, GV, CS%MOM_generic_tracer_CSp, tv, optics) + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics) endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & @@ -575,7 +575,7 @@ end subroutine call_tracer_column_fns !> 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_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, & +subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock_units, & num_stocks, stock_index, got_min_max, global_min, global_max, & xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -584,6 +584,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer !! on the current PE, usually in kg x concentration [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to !! call_tracer_register. @@ -624,7 +625,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni ! Add other user-provided calls here. if (CS%use_USER_tracer_example) then - ns = USER_tracer_stock(h, values, G, GV, CS%USER_tracer_example_CSp, & + ns = USER_tracer_stock(h, values, G, GV, US, CS%USER_tracer_example_CSp, & names, units, stock_index) call store_stocks("tracer_example", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) @@ -636,44 +637,44 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni ! set_pkg_name, max_ns, ns_tot, stock_names, stock_units) ! endif if (CS%use_ideal_age) then - ns = ideal_age_stock(h, values, G, GV, CS%ideal_age_tracer_CSp, & + ns = ideal_age_stock(h, values, G, GV, US, CS%ideal_age_tracer_CSp, & names, units, stock_index) call store_stocks("ideal_age_example", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_regional_dyes) then - ns = dye_stock(h, values, G, GV, CS%dye_tracer_CSp, & + ns = dye_stock(h, values, G, GV, US, CS%dye_tracer_CSp, & names, units, stock_index) call store_stocks("regional_dyes", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_oil) then - ns = oil_stock(h, values, G, GV, CS%oil_tracer_CSp, & + ns = oil_stock(h, values, G, GV, US, CS%oil_tracer_CSp, & names, units, stock_index) call store_stocks("oil_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_OCMIP2_CFC) then - ns = OCMIP2_CFC_stock(h, values, G, GV, CS%OCMIP2_CFC_CSp, names, units, stock_index) + ns = OCMIP2_CFC_stock(h, values, G, GV, US, CS%OCMIP2_CFC_CSp, names, units, stock_index) call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_CFC_cap) then - ns = CFC_cap_stock(h, values, G, GV, CS%CFC_cap_CSp, names, units, stock_index) + ns = CFC_cap_stock(h, values, G, GV, US, CS%CFC_cap_CSp, names, units, stock_index) call store_stocks("MOM_CFC_cap", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_advection_test_tracer) then - ns = advection_test_stock( h, values, G, GV, CS%advection_test_tracer_CSp, & + ns = advection_test_stock( h, values, G, GV, US, CS%advection_test_tracer_CSp, & names, units, stock_index ) call store_stocks("advection_test_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_MOM_generic_tracer) then - ns = MOM_generic_tracer_stock(h, values, G, GV, CS%MOM_generic_tracer_CSp, & + ns = MOM_generic_tracer_stock(h, values, G, GV, US, CS%MOM_generic_tracer_CSp, & names, units, stock_index) call store_stocks("MOM_generic_tracer", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) @@ -684,14 +685,14 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni endif if (CS%use_pseudo_salt_tracer) then - ns = pseudo_salt_stock(h, values, G, GV, CS%pseudo_salt_tracer_CSp, & + ns = pseudo_salt_stock(h, values, G, GV, US, CS%pseudo_salt_tracer_CSp, & names, units, stock_index) call store_stocks("pseudo_salt_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_boundary_impulse_tracer) then - ns = boundary_impulse_stock(h, values, G, GV, CS%boundary_impulse_tracer_CSp, & + ns = boundary_impulse_stock(h, values, G, GV, US, CS%boundary_impulse_tracer_CSp, & names, units, stock_index) call store_stocks("boundary_impulse_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index b713803182..8fdb525b4a 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -344,12 +344,13 @@ end subroutine advection_test_tracer_surface_state !> Calculate the mass-weighted integral of all tracer stocks, returning the number of stocks it has calculated. !! 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) +function advection_test_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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. @@ -373,7 +374,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="advection_test_stock") stocks(m) = 0.0 diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 18e9b8dc8e..ea60a09608 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -46,9 +46,8 @@ module boundary_impulse_tracer integer :: nkml !< Number of layers in mixed layer real, dimension(NTR_MAX) :: land_val = -1.0 !< A value to use to fill in tracers over land - real :: kw_eff !< An effective piston velocity used to flux tracer out at the surface real :: remaining_source_time !< How much longer (same units as the timestep) to - !! inject the tracer at the surface [s] + !! inject the tracer at the surface [T ~> s] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -60,9 +59,10 @@ module boundary_impulse_tracer contains !> Read in runtime options and add boundary impulse tracer to tracer registry -function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) +function register_boundary_impulse_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in ) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. @@ -79,7 +79,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() real, pointer :: rem_time_ptr => NULL() logical :: register_boundary_impulse_tracer @@ -99,7 +99,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar "Length of time for the boundary tracer to be injected "//& "into the mixed layer. After this time has elapsed, the "//& "surface becomes a sink for the boundary impulse tracer.", & - default=31536000.0) + default=31536000.0, scale=US%s_to_T) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code "//& "if they are not found in the restart files. Otherwise "//& @@ -145,13 +145,14 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar end function register_boundary_impulse_tracer !> Initialize tracer from restart or set to 1 at surface to initialize -subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp, tv) 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. 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(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -186,14 +187,17 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=name, caller="initialize_boundary_impulse_tracer") - if ((.not.restart) .or. (.not. & - query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then + if ((.not.restart) .or. (.not. query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then do k=1,CS%nkml ; do j=jsd,jed ; do i=isd,ied CS%tr(i,j,k,m) = 1.0 enddo ; enddo ; enddo endif enddo ! Tracer loop + if (restart .and. (US%s_to_T_restart /= 0.0) .and. (US%s_to_T /= US%s_to_T_restart) ) then + CS%remaining_source_time = (US%s_to_T / US%s_to_T_restart) * CS%remaining_source_time + endif + if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. endif @@ -268,7 +272,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, do k=1,CS%nkml ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 1.0 enddo ; enddo ; enddo - CS%remaining_source_time = CS%remaining_source_time-US%T_to_s*dt + CS%remaining_source_time = CS%remaining_source_time-dt else do k=1,CS%nkml ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 0.0 @@ -283,12 +287,13 @@ end subroutine boundary_impulse_tracer_column_physics !> This function calculates the mass-weighted integral of the boundary impulse, !! tracer stocks returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) +function boundary_impulse_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. @@ -317,7 +322,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,1 call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="boundary_impulse_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 91806bb94e..dca01e974a 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -325,12 +325,13 @@ end subroutine dye_tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) +function dye_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(dye_tracer_CS), pointer :: CS !< The control structure returned by a !! previous call to register_dye_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -356,7 +357,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="dye_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index ca47a8ca1d..d5c813b3d0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -369,13 +369,14 @@ end subroutine ideal_age_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it !! 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) +function ideal_age_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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. @@ -400,7 +401,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="ideal_age_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 index fcb9f3e854..0e66ebbcf3 100644 --- a/src/tracer/nw2_tracers.F90 +++ b/src/tracer/nw2_tracers.F90 @@ -33,7 +33,8 @@ module nw2_tracers type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? - real, allocatable , dimension(:) :: restore_rate !< The exponential growth rate for restoration value [year-1]. + real, allocatable , dimension(:) :: restore_rate !< The rate at which the tracer is damped toward + !! its target profile [T-1 ~> s-1] 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() !< A pointer to the restart controls structure @@ -42,9 +43,10 @@ module nw2_tracers contains !> Register the NW2 tracer fields to be used with MOM. -logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS) +logical function register_nw2_tracers(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_nw2_tracer. @@ -62,7 +64,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS logical :: do_nw2 integer :: isd, ied, jsd, jed, nz, m, ig integer :: n_groups ! Number of groups of three tracers (i.e. # tracers/3) - real, allocatable, dimension(:) :: timescale_in_days + real, allocatable, dimension(:) :: timescale_in_days ! Damping timescale [days] type(vardesc) :: tr_desc ! Descriptions and metadata for the tracers isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -100,7 +102,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, tr_desc=tr_desc, & registry_diags=.true., restart_CS=restart_CS, mandatory=.false.) ig = int( (m+2)/3 ) ! maps (1,2,3)->1, (4,5,6)->2, ... - CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0 ) + CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0*US%s_to_T ) enddo CS%tr_Reg => tr_Reg @@ -125,8 +127,8 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_nw2_tracer. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights - real :: rscl ! z* scaling factor + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] + real :: rscl ! z* scaling factor [nondim] character(len=8) :: var_name ! The variable's name. integer :: i, j, k, m @@ -206,11 +208,11 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! 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_(G)+1) :: eta ! Interface heights + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] integer :: i, j, k, m - real :: dt_x_rate ! dt * restoring rate - real :: rscl ! z* scaling factor + real :: dt_x_rate ! dt * restoring rate [nondim] + real :: rscl ! z* scaling factor [nondim] real :: target_value ! tracer value ! if (.not.associated(CS)) return @@ -253,8 +255,8 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US endif do m=1,CS%ntr - dt_x_rate = ( dt * CS%restore_rate(m) ) * US%T_to_s -!$OMP parallel do default(private) shared(CS,G,dt,dt_x_rate) + dt_x_rate = dt * CS%restore_rate(m) + !$OMP parallel do default(shared) private(target_value) do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec target_value = nw2_tracer_dist(m, G, GV, eta, i, j, k) CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j) * dt_x_rate * ( target_value - CS%tr(i,j,k,m) ) @@ -270,13 +272,13 @@ real function nw2_tracer_dist(m, G, GV, eta, i, j, k) 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),0:SZK_(G)), & - intent(in) :: eta !< Interface position [m] + intent(in) :: eta !< Interface position [Z ~> m] integer, intent(in) :: i !< Cell index i integer, intent(in) :: j !< Cell index j integer, intent(in) :: k !< Layer index k ! Local variables - real :: pi ! 3.1415... - real :: x, y, z ! non-dimensional positions + real :: pi ! 3.1415... [nondim] + real :: x, y, z ! non-dimensional relative positions [nondim] pi = 2.*acos(0.) x = ( G%geolonT(i,j) - G%west_lon ) / G%len_lon ! 0 ... 1 y = -G%geolatT(i,j) / G%south_lat ! -1 ... 1 diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 862209a688..6f690ab760 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -51,7 +51,6 @@ module oil_tracer real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. - real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil [T-1 ~> s-1] calculated from oil_decay_days integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code @@ -83,7 +82,8 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! Local variables character(len=40) :: mdl = "oil_tracer" ! This module's name. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" + real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying oils @@ -136,7 +136,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "OIL_SOURCE_RATE", CS%oil_source_rate, & "The rate of oil injection.", & units="kg s-1", scale=US%T_to_s, default=1.0) - call get_param(param_file, mdl, "OIL_DECAY_DAYS", CS%oil_decay_days, & + call get_param(param_file, mdl, "OIL_DECAY_DAYS", oil_decay_days, & "The decay timescale in days (if positive), or no decay "//& "if 0, or use the temperature dependent decay rate of "//& "Adcroft et al. (GRL, 2010) if negative.", units="days", & @@ -156,9 +156,9 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) CS%ntr = CS%ntr + 1 CS%tr_desc(m) = var_desc("oil"//trim(name_tag), "kg m-3", "Oil Tracer", caller=mdl) CS%IC_val(m) = 0.0 - if (CS%oil_decay_days(m)>0.) then - CS%oil_decay_rate(m) = 1. / (86400.0*US%s_to_T * CS%oil_decay_days(m)) - elseif (CS%oil_decay_days(m)<0.) then + if (oil_decay_days(m) > 0.) then + CS%oil_decay_rate(m) = 1. / (86400.0*US%s_to_T * oil_decay_days(m)) + elseif (oil_decay_days(m) < 0.) then CS%oil_decay_rate(m) = -1. endif endif @@ -326,9 +326,12 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! Local variables 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 :: Isecs_per_year = 1.0 / (365.0*86400.0) ! Conversion factor from seconds to year [year s-1] real :: vol_scale ! A conversion factor for volumes into m3 [m3 H-1 L-2 ~> 1 or m3 kg-1] - real :: year, h_total, ldecay + real :: year ! Time in fractional years [years] + real :: h_total ! A running sum of thicknesses [H ~> m or kg m-2] + real :: decay_timescale ! Chemical decay timescale for oil [T ~> s] + real :: ldecay ! Chemical decay rate of oil [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz, m, k_max is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -360,8 +363,8 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (CS%oil_decay_rate(m)>0.) then CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*CS%oil_decay_rate(m),0.)*CS%tr(i,j,k,m) ! Safest elseif (CS%oil_decay_rate(m)<0.) then - ldecay = 12.*(3.0**(-(tv%T(i,j,k)-20.)/10.)) ! Timescale [days] - ldecay = 1. / (86400.*US%s_to_T * ldecay) ! Rate [T-1 ~> s-1] + decay_timescale = (12.*(3.0**(-(tv%T(i,j,k)-20.)/10.))) * (86400.*US%s_to_T) ! Timescale [s ~> T] + ldecay = 1. / decay_timescale ! Rate [T-1 ~> s-1] CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*ldecay,0.)*CS%tr(i,j,k,m) endif enddo ; enddo ; enddo @@ -399,12 +402,13 @@ end subroutine oil_tracer_column_physics !> Calculate the mass-weighted integral of the oil tracer stocks, returning the number of stocks it !! has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) +function oil_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -429,7 +433,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="oil_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 94ee126a59..c441e519be 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -253,12 +253,13 @@ end subroutine pseudo_salt_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) +function pseudo_salt_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_pseudo_salt_tracer character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated @@ -284,7 +285,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 call query_vardesc(CS%tr_desc, name=names(1), units=units(1), caller="pseudo_salt_stock") units(1) = trim(units(1))//" kg" stocks(1) = 0.0 diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 10551ea247..a41f0ab76d 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -358,13 +358,14 @@ end subroutine tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) +function USER_tracer_stock(h, stocks, G, GV, US, 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_(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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a !! previous call to register_USER_tracer. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -389,7 +390,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,NTR call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="USER_tracer_stock") units(m) = trim(units(m))//" kg" diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 317ed4ac21..ff98f16529 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -133,13 +133,14 @@ 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, GV, Time) +subroutine dyed_channel_update_flow(OBC, CS, G, GV, US, 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Time !< model time. ! Local variables character(len=40) :: mdl = "dyed_channel_update_flow" ! This subroutine's name. @@ -154,7 +155,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, GV, Time) if (.not.associated(OBC)) call MOM_error(FATAL, 'dyed_channel_initialization.F90: '// & 'dyed_channel_update_flow() was called but OBC type was not initialized!') - time_sec = G%US%s_to_T * time_type_to_real(Time) + time_sec = US%s_to_T * time_type_to_real(Time) PI = 4.0*atan(1.0) do l=1, OBC%number_of_segments diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 2c84a6040c..840f0bf3ed 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -158,7 +158,7 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) time_sec = US%s_to_T*time_type_to_real(Time) omega = CS%omega alpha = CS%alpha - my_amp = 1.0*G%US%m_s_to_L_T + my_amp = 1.0*US%m_s_to_L_T jj = CS%jj kk = CS%kk ll = CS%ll diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 12a31f3a75..b4ceb1905d 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -8,8 +8,9 @@ module supercritical_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_segment_type -use MOM_verticalGrid, only : verticalGrid_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 @@ -17,18 +18,16 @@ module supercritical_initialization public supercritical_set_OBC_data -! This include declares and sets the variable "version". -#include "version_variable.h" - contains !> This subroutine sets the properties of flow at open boundary conditions. -subroutine supercritical_set_OBC_data(OBC, G, GV, param_file) +subroutine supercritical_set_OBC_data(OBC, G, GV, US, 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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. @@ -42,7 +41,7 @@ subroutine supercritical_set_OBC_data(OBC, G, GV, param_file) call get_param(param_file, mdl, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & "Constant zonal flow imposed at upstream open boundary.", & - units="m/s", default=8.57, scale=G%US%m_s_to_L_T) + units="m/s", default=8.57, scale=US%m_s_to_L_T) do l=1, OBC%number_of_segments segment => OBC%segment(l) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 51772e2f9f..2438b4115a 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -51,13 +51,14 @@ function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) end function register_tidal_bay_OBC !> This subroutine sets the properties of flow at open boundary conditions. -subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) +subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, 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), intent(in) :: CS !< tidal bay control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] type(time_type), intent(in) :: Time !< model time. @@ -84,7 +85,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) allocate(my_area(1:1,js:je)) - flux_scale = GV%H_to_m*G%US%L_to_m + flux_scale = GV%H_to_m*US%L_to_m time_sec = time_type_to_real(Time) cff_eta = 0.1*GV%m_to_H * sin(2.0*PI*time_sec/(12.0*3600.0)) @@ -108,7 +109,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) if (.not. segment%on_pe) cycle - segment%normal_vel_bt(:,:) = my_flux / (G%US%m_to_Z*G%US%m_to_L*total_area) + segment%normal_vel_bt(:,:) = my_flux / (US%m_to_Z*US%m_to_L*total_area) segment%eta(:,:) = cff_eta enddo ! end segment loop From 986bc8c0b9391222fe84c95c1db3fe8d1743d342 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Dec 2021 20:19:21 -0500 Subject: [PATCH 117/138] Corrected the unit documentation for 31 variables Corrected the documentation of the units for 31 variables in various modules. All answers and output are bitwise identical. --- src/core/MOM_PressureForce_FV.F90 | 3 ++- src/core/MOM_continuity_PPM.F90 | 4 ++-- src/core/MOM_dynamics_split_RK2.F90 | 4 ++-- src/diagnostics/MOM_wave_structure.F90 | 16 ++++++++-------- src/initialization/MOM_shared_initialization.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 4 ++-- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 4 ++-- src/tracer/MOM_lateral_boundary_diffusion.F90 | 2 +- src/tracer/MOM_tracer_registry.F90 | 3 ++- src/user/Idealized_Hurricane.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 5 +++-- src/user/SCM_CVMix_tests.F90 | 6 +++--- src/user/baroclinic_zone_initialization.F90 | 2 +- 14 files changed, 31 insertions(+), 28 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 5ead019717..1666b4a97e 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -153,7 +153,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1]. real :: H_to_RL2_T2 ! A factor to convert from thickness units (H) to pressure ! units [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]. -! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] +! real :: oneatm ! 1 standard atmosphere of pressure in [R L2 T-2 ~> Pa] real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -187,6 +187,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ p(i,j,1) = p_atm(i,j) enddo ; enddo else + ! oneatm = 101325.0 * US%kg_m3_to_R * US%m_s_to_L_T**2 ! 1 atm scaled to [R L2 T-2 ~> Pa] !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 p(i,j,1) = 0.0 ! or oneatm diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 17d2f830c0..7bc67e2fdf 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -924,8 +924,8 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and uhtot_R ! and easterly (uhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m]. - real :: FA_avg ! The average effective face area [L H ~> m2 or kg m], nominally given by + real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m-1]. + real :: FA_avg ! The average effective face area [L H ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim]. This ! limiting is necessary to keep the inverse of visc_rem diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index a762da7f33..f1a2b2469d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -337,8 +337,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real, pointer, dimension(:,:,:) :: & ! These pointers are used to alter which fields are passed to btstep with various options: - u_ptr => NULL(), & ! A pointer to a zonal velocity [L T-1] - v_ptr => NULL(), & ! A pointer to a meridional velocity [L T-1] + u_ptr => NULL(), & ! A pointer to a zonal velocity [L T-1 ~> m s-1] + v_ptr => NULL(), & ! A pointer to a meridional velocity [L T-1 ~> m s-1] uh_ptr => NULL(), & ! A pointer to a zonal volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] vh_ptr => NULL(), & ! A pointer to a meridional volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] ! These pointers are just used as shorthand for CS%u_av, CS%v_av, and CS%h_av. diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 2dd272d409..c833e973c5 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -171,11 +171,11 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo 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 :: int_dwdz2 !< Vertical integral of the square of u_strct [Z ~> m] + real :: int_w2 !< Vertical integral of the square of w_strct [Z ~> m] + real :: int_N2w2 !< Vertical integral of N2 [Z T-2 ~> m s-2] + real :: KE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] + real :: PE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] real :: W0 !< A vertical velocity magnitude [Z T-1 ~> m s-1] real :: 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 @@ -183,8 +183,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo 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, dimension(SZK_(GV)-1) :: e_guess !< guess at eigen vector with unit amplitude (for TDMA) [nondim] + real, dimension(SZK_(GV)-1) :: e_itt !< improved guess at eigen vector (from TDMA) [nondim] real :: Pi integer :: kc integer :: i, j, k, k2, itt, is, ie, js, je, nz, nzm, row, ig, jg, ig_stop, jg_stop @@ -523,7 +523,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (present(En) .and. (freq**2*Kmag2 > 0.0)) then - ! Units here are [R + ! Units here are [R Z ~> kg m-2] KE_term = 0.25*GV%Rho0*( ((freq**2 + f2) / (freq**2*Kmag2))*int_dwdz2 + int_w2 ) PE_term = 0.25*GV%Rho0*( int_N2w2 / freq**2 ) if (En(i,j) >= 0.0) then diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index bb5a84033b..fc5ceaf3e4 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -814,7 +814,7 @@ subroutine reset_face_lengths_list(G, param_file, US) real, allocatable, dimension(:) :: & Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] real, allocatable, dimension(:) :: & - Dmin_v, Dmax_v, Davg_v + Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [m] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 046329523d..dd160c300c 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -489,7 +489,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes ! netMassOut = water [H ~> m or kg m-2] removed via evaporating surface fluxes ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] - ! net_salt = salt via surface fluxes [ppt H ~> dppt m or gSalt m-2] + ! net_salt = salt via surface fluxes [ppt H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & @@ -1527,7 +1527,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained ! [Z L2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [L2 T-2 ~> L2 s-2]. + ! across the mixed layer [L2 T-2 ~> m2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in ! TKE, divided by layer thickness in m [L2 T-2 ~> m2 s-2]. real :: Cpen1 ! A temporary variable [L2 T-2 ~> m2 s-2]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 312d114dde..c421b3a0f7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1171,7 +1171,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! netMassOut < 0 means mass leaves ocean. ! netHeat = heat via surface fluxes [degC H ~> degC m or degC kg m-2], excluding the part ! contained in Pen_SW_bnd; and excluding heat_content of netMassOut < 0. - ! netSalt = surface salt fluxes [ppt H ~> dppt m or gSalt m-2] + ! netSalt = surface salt fluxes [ppt H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation split according to bands. ! This field provides that portion of SW from atmosphere that in fact ! enters to the ocean and participates in pentrative SW heating. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 861a8957c1..f7d4b0cc0d 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -200,7 +200,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H T T-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl @@ -597,7 +597,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! When stratification dominates h_N< kg m-2 or kg m-5] + ustarsq = Rho0x400_G * ustar(i)**2 ! Note not in units of u*^2 but [H R ~> kg m-2 or kg2 m-5] htot = 0.0 ! Calculate the thickness of a stratification limited BBL ignoring rotation: diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 19d40f2db1..c11bc9856c 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -596,7 +596,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ real, allocatable :: F_layer_z(:) !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] real :: h_vel(ke) !< Thicknesses at u- and v-points in the native grid !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] - real :: khtr_avg !< Thickness-weighted diffusivity at the velocity-point [L2 T-1 ~> m s-1] + real :: khtr_avg !< Thickness-weighted diffusivity at the velocity-point [L2 T-1 ~> m2 s-1] !! This is just to remind developers that khtr_avg should be !! computed once khtr is 3D. real :: htot !< Total column thickness [H ~> m or kg m-2] diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index c729231927..2c77df3e74 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -84,7 +84,8 @@ module MOM_tracer_registry ! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes ! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] ! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! expressed as a change in concentration [conc T-1] +! !! expressed as a change in concentration +! !! [conc T-1 ~> conc s-1] real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous !! timestep used for diagnostics [conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 7182fc364a..707a0972f9 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -595,7 +595,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C U_TS = CS%hurr_translation_spd*0.5*cos(transdir) V_TS = CS%hurr_translation_spd*0.5*sin(transdir) - ! Set the surface wind stresses, in [Pa]. A positive taux + ! Set the surface wind stresses, in [R L Z T-2 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index f783a271a6..d136d58a19 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -46,7 +46,7 @@ module MOM_controlled_forcing real :: lam_prec !< A constant of proportionality between SSS anomalies !! (normalised by mean SSS) and precipitation [R Z T-1 ~> kg m-2 s-1] real :: lam_cyc_heat !< A constant of proportionality between cyclical SST - !! anomalies and corrective heat fluxes [W m-2 degC-1] + !! anomalies and corrective heat fluxes [Q R Z T-1 degC-1 ~> W m-2 degC-1] real :: lam_cyc_prec !< A constant of proportionality between cyclical SSS !! anomalies (normalised by mean SSS) and corrective !! precipitation [R Z T-1 ~> kg m-2 s-1] @@ -270,7 +270,8 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec ! Accumulate the average anomalies for this period. dt_wt = wt_per1 * dt CS%avg_time(m_mid) = CS%avg_time(m_mid) + dt_wt - ! These loops temporarily change the units of the CS%avg_ variables to [degC s] or [ppt s]. + ! These loops temporarily change the units of the CS%avg_ variables to [degC T ~> degC s] + ! or [ppt T ~> ppt s]. do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_mid) = CS%avg_SST_anom(i,j,m_mid) + & dt_wt * G%mask2dT(i,j) * SST_anom(i,j) diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 1fbc7a2b62..5bbe65b8d8 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -36,8 +36,8 @@ module SCM_CVMix_tests logical :: UseHeatFlux !< True to use heat flux logical :: UseEvaporation !< True to use evaporation logical :: UseDiurnalSW !< True to use diurnal sw radiation - real :: tau_x !< (Constant) Wind stress, X [Pa] - real :: tau_y !< (Constant) Wind stress, Y [Pa] + real :: tau_x !< (Constant) Wind stress, X [R L Z T-2 ~> Pa] + real :: tau_y !< (Constant) Wind stress, Y [R L Z T-2 ~> Pa] real :: surf_HF !< (Constant) Heat flux [degC Z T-1 ~> m degC s-1] real :: surf_evap !< (Constant) Evaporation rate [Z T-1 ~> m s-1] real :: Max_sw !< maximum of diurnal sw radiation [degC Z T-1 ~> degC m s-1] @@ -56,7 +56,7 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [psu] + 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 1555f4ecad..a214012541 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -36,7 +36,7 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, real, intent(out) :: S_ref !< Reference salinity [ppt] real, intent(out) :: dSdz !< Salinity stratification [ppt Z-1 ~> ppt m-1] real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [ppt] - real, intent(out) :: dSdx !< Linear salinity gradient [ppt m-1] + real, intent(out) :: dSdx !< Linear salinity gradient [ppt G%xaxis_units-1] real, intent(out) :: T_ref !< Reference temperature [degC] real, intent(out) :: dTdz !< Temperature stratification [degC Z-1 ~> degC m-1] real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [degC] From d2442461abdaf32cb9d737d3e798fcdea597b239 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Dec 2021 13:25:16 -0500 Subject: [PATCH 118/138] +Rescale tides and ramp-up times Rescaled the dimensions of the tidal amplitudes and frequencies used internally in calc_tidal_forcing() and ramp-up times used by update_OBC_ramp() and updateCFLtruncationValue() for nearly complete dimensional consistency testing. New unit_scale_type arguments were added to 5 routines, in the case of calc_tidal_forcing() replacing a previous optional argument that was always being used. One overly short internal variable, "N", was renamed "nodelon" to make its purpose clearer and easier to search for. All answers are bitwise identical, but there are changes to the argument lists of 5 routines. --- src/core/MOM_PressureForce_FV.F90 | 4 +- src/core/MOM_PressureForce_Montgomery.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 10 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- src/core/MOM_open_boundary.F90 | 25 +-- .../lateral/MOM_tidal_forcing.F90 | 158 ++++++++++-------- .../vertical/MOM_vert_friction.F90 | 34 ++-- 8 files changed, 127 insertions(+), 112 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 1666b4a97e..30b2e90d1a 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -306,7 +306,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - GV%g_Earth * e_tidal(i,j) @@ -574,7 +574,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) endif ! Here layer interface heights, e, are calculated. diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index a827fb12d0..18ea07b313 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -203,7 +203,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo ; enddo endif - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) @@ -451,7 +451,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) endif ! Here layer interface heights, e, are calculated. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f1a2b2469d..68b844562f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -374,7 +374,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ! Update CFL truncation value as function of time - call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) + call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp, US) if (CS%debug) then call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) @@ -395,7 +395,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug_OBC) call open_boundary_test_extern_h(G, GV, CS%OBC, h) ! Update OBC ramp value as function of time - call update_OBC_ramp(Time_local, CS%OBC) + call update_OBC_ramp(Time_local, CS%OBC, US) do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB u_old_rad_OBC(I,j,k) = u_av(I,j,k) @@ -1207,20 +1207,20 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) - if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) CS%set_visc_CSp => set_visc - call updateCFLtruncationValue(Time, CS%vertvisc_CSp, & + call updateCFLtruncationValue(Time, CS%vertvisc_CSp, US, & activate=is_new_run(restart_CS) ) if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) then CS%OBC => OBC - if (OBC%ramp) call update_OBC_ramp(Time, CS%OBC, & + if (OBC%ramp) call update_OBC_ramp(Time, CS%OBC, US, & activate=is_new_run(restart_CS) ) endif if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 88a11e071c..fcc4c3d49b 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -666,7 +666,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) - if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 26bd00aaf5..694d88f2ea 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -628,7 +628,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) - if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6d8696216a..2c3f016005 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -264,7 +264,7 @@ module MOM_open_boundary logical :: add_tide_constituents = .false. !< If true, add tidal constituents to the boundary elevation !! and velocity. Will be set to true if n_tide_constituents > 0. character(len=2), allocatable, dimension(:) :: tide_names !< Names of tidal constituents to add to the boundary data. - real, allocatable, dimension(:) :: tide_frequencies !< Angular frequencies of chosen tidal constituents [s-1]. + real, allocatable, dimension(:) :: tide_frequencies !< Angular frequencies of chosen tidal constituents [T-1 ~> s-1]. real, allocatable, dimension(:) :: tide_eq_phases !< Equilibrium phases of chosen tidal constituents [rad]. real, allocatable, dimension(:) :: tide_fn !< Amplitude modulation of boundary tides by nodal cycle [nondim]. real, allocatable, dimension(:) :: tide_un !< Phase modulation of boundary tides by nodal cycle [rad]. @@ -305,8 +305,8 @@ module MOM_open_boundary !! the independence of the OBCs to this external data [L T-1 ~> m s-1]. logical :: ramp = .false. !< If True, ramp from zero to the external values for SSH. logical :: ramping_is_activated = .false. !< True if the ramping has been initialized - real :: ramp_timescale !< If ramp is True, use this timescale for ramping [s]. - real :: trunc_ramp_time !< If ramp is True, time after which ramp is done [s]. + real :: ramp_timescale !< If ramp is True, use this timescale for ramping [T ~> s]. + real :: trunc_ramp_time !< If ramp is True, time after which ramp is done [T ~> s]. real :: ramp_value !< If ramp is True, where we are on the ramp from !! zero to one [nondim]. type(time_type) :: ramp_start_time !< Time when model was started. @@ -627,7 +627,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) "Symmetric memory must be used when using Flather OBCs.") ! Need to do this last, because it depends on time_interp_external_init having already been called if (OBC%add_tide_constituents) then - call initialize_obc_tides(OBC, param_file) + call initialize_obc_tides(OBC, US, param_file) ! Tide update is done within update_OBC_segment_data, so this should be true if tides are included. OBC%update_OBC = .true. endif @@ -948,8 +948,9 @@ subroutine initialize_segment_data(G, OBC, PF) end subroutine initialize_segment_data -subroutine initialize_obc_tides(OBC, param_file) +subroutine initialize_obc_tides(OBC, US, param_file) type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing (year, month, day). integer, dimension(3) :: nodal_ref_date !< Date to calculate nodal modulation for (year, month, day). @@ -1022,7 +1023,8 @@ subroutine initialize_obc_tides(OBC, param_file) "Frequency of the "//trim(OBC%tide_names(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(OBC%tide_names(c))// & " are true, or if OBC_TIDE_N_CONSTITUENTS > 0 and "//trim(OBC%tide_names(c))//& - " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=tidal_frequency(trim(OBC%tide_names(c)))) + " is in OBC_TIDE_CONSTITUENTS.", & + units="s-1", default=tidal_frequency(trim(OBC%tide_names(c))), scale=US%T_to_s) ! Find equilibrium phase if needed if (OBC%add_eq_phase) then @@ -3727,7 +3729,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) real :: tidal_elev ! Interpolated tidal elevation at the OBC points [m] real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1] integer :: turns ! Number of index quarter turns - real :: time_delta ! Time since tidal reference date [s] + real :: time_delta ! Time since tidal reference date [T ~> s] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3738,7 +3740,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (.not. associated(OBC)) return - if (OBC%add_tide_constituents) time_delta = time_type_to_real(Time - OBC%time_ref) + if (OBC%add_tide_constituents) time_delta = US%s_to_T * time_type_to_real(Time - OBC%time_ref) do n = 1, OBC%number_of_segments segment => OBC%segment(n) @@ -4336,14 +4338,15 @@ end subroutine update_OBC_segment_data !> Update the OBC ramp value as a function of time. !! If called with the optional argument activate=.true., record the !! value of Time as the beginning of the ramp period. -subroutine update_OBC_ramp(Time, OBC, activate) +subroutine update_OBC_ramp(Time, OBC, US, activate) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: activate !< Specify whether to record the value of !! Time as the beginning of the ramp period ! Local variables - real :: deltaTime ! The time since start of ramping [s] + real :: deltaTime ! The time since start of ramping [T ~> s] real :: wghtA ! A temporary variable used to set OBC%ramp_value [nondim] character(len=12) :: msg @@ -4359,7 +4362,7 @@ subroutine update_OBC_ramp(Time, OBC, activate) endif endif if (.not.OBC%ramping_is_activated) return - deltaTime = max( 0., time_type_to_real( Time - OBC%ramp_start_time ) ) + deltaTime = max( 0., US%s_to_T*time_type_to_real( Time - OBC%ramp_start_time ) ) if (deltaTime >= OBC%trunc_ramp_time) then OBC%ramp_value = 1.0 OBC%ramp = .false. ! This turns off ramping after this call diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index b8d5c44098..cc4517a473 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -11,6 +11,7 @@ module MOM_tidal_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : field_exists, file_exists, MOM_read_data use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-) +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -47,12 +48,12 @@ module MOM_tidal_forcing !! astronomical/equilibrium argument. real :: sal_scalar !< The constant of proportionality between sea surface !! height (really it should be bottom pressure) anomalies - !! and bottom geopotential anomalies. + !! and bottom geopotential anomalies [nondim]. integer :: nc !< The number of tidal constituents in use. real, dimension(MAX_CONSTITUENTS) :: & - freq, & !< The frequency of a tidal constituent [s-1]. - phase0, & !< The phase of a tidal constituent at time 0, in radians. - amp, & !< The amplitude of a tidal constituent at time 0 [m]. + freq, & !< The frequency of a tidal constituent [T-1 ~> s-1]. + phase0, & !< The phase of a tidal constituent at time 0 [rad]. + amp, & !< The amplitude of a tidal constituent at time 0 [Z ~> m]. love_no !< The Love number of a tidal constituent at time 0 [nondim]. integer :: struct(MAX_CONSTITUENTS) !< An encoded spatial structure for each constituent character (len=16) :: const_name(MAX_CONSTITUENTS) !< The name of each constituent @@ -62,13 +63,13 @@ module MOM_tidal_forcing !! tidal phases at t = 0. real, allocatable :: & sin_struct(:,:,:), & !< The sine and cosine based structures that can - cos_struct(:,:,:), & !< be associated with the astronomical forcing. + cos_struct(:,:,:), & !< be associated with the astronomical forcing [nondim]. cosphasesal(:,:,:), & !< The cosine and sine of the phase of the sinphasesal(:,:,:), & !< self-attraction and loading amphidromes. - ampsal(:,:,:), & !< The amplitude of the SAL [m]. + ampsal(:,:,:), & !< The amplitude of the SAL [Z ~> m]. cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. - amp_prev(:,:,:) !< The amplitude of the previous tidal solution [m]. + amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m]. end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides @@ -87,8 +88,9 @@ module MOM_tidal_forcing subroutine astro_longitudes_init(time_ref, longitudes) type(time_type), intent(in) :: time_ref !> Time to calculate longitudes for. type(astro_longitudes), intent(out) :: longitudes !> Lunar and solar longitudes at time_ref. - real :: D, T !> Date offsets - real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... + real :: D !> Time since the reference date [days] + real :: T !> Time in Julian centuries [centuries] + real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] ! Find date at time_ref in days since 1900-01-01 D = time_type_to_real(time_ref - set_date(1900, 1, 1)) / (24.0 * 3600.0) ! Time since 1900-01-01 in Julian centuries @@ -176,44 +178,45 @@ end function tidal_frequency !> Find amplitude (f) and phase (u) modulation of tidal constituents by the 18.6 !! year nodal cycle. Values here follow Table I.6 in Kowalik and Luick, !! "Modern Theory and Practice of Tide Analysis and Tidal Power", 2019. -subroutine nodal_fu(constit, N, fn, un) - character (len=2), intent(in) :: constit !> Tidal constituent to find modulation for. - real, intent(in) :: N !> Longitude of ascending node [rad]. - !! Calculate using astro_longitudes_init. - real, parameter :: RADIANS = 4.0 * atan(1.0) / 180.0 !> Converts degrees to radians. - real, intent(out) :: & - fn, & !> Amplitude modulation [nondim] - un !> Phase modulation [rad] +subroutine nodal_fu(constit, nodelon, fn, un) + character (len=2), intent(in) :: constit !> Tidal constituent to find modulation for. + real, intent(in) :: nodelon !> Longitude of ascending node [rad], which + !! can be calculated using astro_longitudes_init. + real, intent(out) :: fn !> Amplitude modulation [nondim] + real, intent(out) :: un !> Phase modulation [rad] + + real, parameter :: RADIANS = 4.0 * atan(1.0) / 180.0 !> Converts degrees to radians [nondim] + select case (constit) case ("M2") - fn = 1.0 - 0.037 * cos(N) - un = -2.1 * RADIANS * sin(N) + fn = 1.0 - 0.037 * cos(nodelon) + un = -2.1 * RADIANS * sin(nodelon) case ("S2") fn = 1.0 ! Solar S2 has no amplitude modulation. un = 0.0 ! S2 has no phase modulation. case ("N2") - fn = 1.0 - 0.037 * cos(N) - un = -2.1 * RADIANS * sin(N) + fn = 1.0 - 0.037 * cos(nodelon) + un = -2.1 * RADIANS * sin(nodelon) case ("K2") - fn = 1.024 + 0.286 * cos(N) - un = -17.7 * RADIANS * sin(N) + fn = 1.024 + 0.286 * cos(nodelon) + un = -17.7 * RADIANS * sin(nodelon) case ("K1") - fn = 1.006 + 0.115 * cos(N) - un = -8.9 * RADIANS * sin(N) + fn = 1.006 + 0.115 * cos(nodelon) + un = -8.9 * RADIANS * sin(nodelon) case ("O1") - fn = 1.009 + 0.187 * cos(N) - un = 10.8 * RADIANS * sin(N) + fn = 1.009 + 0.187 * cos(nodelon) + un = 10.8 * RADIANS * sin(nodelon) case ("P1") fn = 1.0 ! P1 has no amplitude modulation. un = 0.0 ! P1 has no phase modulation. case ("Q1") - fn = 1.009 + 0.187 * cos(N) - un = 10.8 * RADIANS * sin(N) + fn = 1.009 + 0.187 * cos(nodelon) + un = 10.8 * RADIANS * sin(nodelon) case ("MF") - fn = 1.043 + 0.414 * cos(N) - un = -23.7 * RADIANS * sin(N) + fn = 1.043 + 0.414 * cos(nodelon) + un = -23.7 * RADIANS * sin(nodelon) case ("MM") - fn = 1.0 - 0.130 * cos(N) + fn = 1.0 - 0.130 * cos(nodelon) un = 0.0 ! MM has no phase modulation. case default call MOM_error(FATAL, "nodal_fu: unrecognized constituent") @@ -226,10 +229,11 @@ end subroutine nodal_fu !! while fields like the background viscosities are 2-D arrays. !! ALLOC is a macro defined in MOM_memory.h for allocate or nothing with !! static memory. -subroutine tidal_forcing_init(Time, G, param_file, CS) - type(time_type), intent(in) :: Time !< The current model time. - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. +subroutine tidal_forcing_init(Time, G, US, param_file, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct ! Local variables @@ -237,15 +241,18 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) phase, & ! The phase of some tidal constituent. lat_rad, lon_rad ! Latitudes and longitudes of h-points in radians. real :: deg_to_rad - real, dimension(MAX_CONSTITUENTS) :: freq_def, phase0_def, amp_def, love_def + real, dimension(MAX_CONSTITUENTS) :: freq_def ! Default frequency for each tidal constituent [s-1] + real, dimension(MAX_CONSTITUENTS) :: phase0_def ! Default reference phase for each tidal constituent [rad] + real, dimension(MAX_CONSTITUENTS) :: amp_def ! Default amplitude for each tidal constituent [m] + real, dimension(MAX_CONSTITUENTS) :: love_def ! Default love number for each constituent [nondim] integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing. logical :: use_const ! True if a constituent is being used. logical :: use_M2, use_S2, use_N2, use_K2, use_K1, use_O1, use_P1, use_Q1 logical :: use_MF, use_MM logical :: tides ! True if a tidal forcing is to be used. logical :: FAIL_IF_MISSING = .true. -! 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_tidal_forcing" ! This module's name. character(len=128) :: mesg character(len=200) :: tidal_input_files(4*MAX_CONSTITUENTS) @@ -389,68 +396,68 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) endif CS%time_ref = set_date(tide_ref_date(1), tide_ref_date(2), tide_ref_date(3)) endif - ! Set the parameters for all components that are in use. - ! Initialize reference time for tides and - ! find relevant lunar and solar longitudes at the reference time. + + ! Initialize reference time for tides and find relevant lunar and solar + ! longitudes at the reference time. if (CS%use_eq_phase) call astro_longitudes_init(CS%time_ref, CS%tidal_longitudes) + + ! Set the parameters for all components that are in use. c=0 if (use_M2) then c=c+1 ; CS%const_name(c) = "M2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.242334 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.242334 ! Default amplitude in m. endif if (use_S2) then c=c+1 ; CS%const_name(c) = "S2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.112743 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.112743 ! Default amplitude in m. endif if (use_N2) then c=c+1 ; CS%const_name(c) = "N2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.046397 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.046397 ! Default amplitude in m. endif if (use_K2) then c=c+1 ; CS%const_name(c) = "K2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.030684 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.030684 ! Default amplitude in m. endif if (use_K1) then c=c+1 ; CS%const_name(c) = "K1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.736 ; CS%amp(c) = 0.141565 + CS%love_no(c) = 0.736 ; amp_def(c) = 0.141565 ! Default amplitude in m. endif if (use_O1) then c=c+1 ; CS%const_name(c) = "O1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.695 ; CS%amp(c) = 0.100661 + CS%love_no(c) = 0.695 ; amp_def(c) = 0.100661 ! Default amplitude in m. endif if (use_P1) then c=c+1 ; CS%const_name(c) = "P1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.706 ; CS%amp(c) = 0.046848 + CS%love_no(c) = 0.706 ; amp_def(c) = 0.046848 ! Default amplitude in m. endif if (use_Q1) then c=c+1 ; CS%const_name(c) = "Q1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.695 ; CS%amp(c) = 0.019273 + CS%love_no(c) = 0.695 ; amp_def(c) = 0.019273 ! Default amplitude in m. endif if (use_MF) then c=c+1 ; CS%const_name(c) = "MF" ; CS%struct(c) = 3 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.042041 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.042041 ! Default amplitude in m. endif if (use_MM) then c=c+1 ; CS%const_name(c) = "MM" ; CS%struct(c) = 3 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.022191 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.022191 ! Default amplitude in m. endif ! Set defaults for all included constituents ! and things that can be set by functions do c=1,nc - CS%freq(c) = tidal_frequency(CS%const_name(c)) - freq_def(c) = CS%freq(c) + freq_def(c) = tidal_frequency(CS%const_name(c)) love_def(c) = CS%love_no(c) - amp_def(c) = CS%amp(c) CS%phase0(c) = 0.0 if (CS%use_eq_phase) then phase0_def(c) = eq_phase(CS%const_name(c), CS%tidal_longitudes) @@ -467,11 +474,11 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) "Frequency of the "//trim(CS%const_name(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & " are true, or if OBC_TIDE_N_CONSTITUENTS > 0 and "//trim(CS%const_name(c))// & - " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=freq_def(c)) + " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=freq_def(c), scale=US%T_to_s) call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_AMP", CS%amp(c), & "Amplitude of the "//trim(CS%const_name(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & - " are true.", units="m", default=amp_def(c)) + " are true.", units="m", default=amp_def(c), scale=US%m_to_Z) call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_PHASE_T0", CS%phase0(c), & "Phase of the "//trim(CS%const_name(c))//" tidal constituent at time 0. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & @@ -484,8 +491,9 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) allocate(CS%ampsal(isd:ied,jsd:jed,nc)) do c=1,nc ! Read variables with names like PHASE_SAL_M2 and AMP_SAL_M2. - call find_in_files(tidal_input_files,"PHASE_SAL_"//trim(CS%const_name(c)),phase,G) - call find_in_files(tidal_input_files,"AMP_SAL_"//trim(CS%const_name(c)),CS%ampsal(:,:,c),G) + call find_in_files(tidal_input_files, "PHASE_SAL_"//trim(CS%const_name(c)), phase, G) + call find_in_files(tidal_input_files, "AMP_SAL_"//trim(CS%const_name(c)), CS%ampsal(:,:,c), & + G, scale=US%m_to_Z) call pass_var(phase, G%domain,complete=.false.) call pass_var(CS%ampsal(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -501,8 +509,9 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) allocate(CS%amp_prev(isd:ied,jsd:jed,nc)) do c=1,nc ! Read variables with names like PHASE_PREV_M2 and AMP_PREV_M2. - call find_in_files(tidal_input_files,"PHASE_PREV_"//trim(CS%const_name(c)),phase,G) - call find_in_files(tidal_input_files,"AMP_PREV_"//trim(CS%const_name(c)),CS%amp_prev(:,:,c),G) + call find_in_files(tidal_input_files, "PHASE_PREV_"//trim(CS%const_name(c)), phase, G) + call find_in_files(tidal_input_files, "AMP_PREV_"//trim(CS%const_name(c)), CS%amp_prev(:,:,c), & + G, scale=US%m_to_Z) call pass_var(phase, G%domain,complete=.false.) call pass_var(CS%amp_prev(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -518,18 +527,19 @@ end subroutine tidal_forcing_init !> This subroutine finds a named variable in a list of files and reads its !! values into a domain-decomposed 2-d array -subroutine find_in_files(filenames, varname, array, G) +subroutine find_in_files(filenames, varname, array, G, scale) character(len=*), dimension(:), intent(in) :: filenames !< The names of the files to search for the named variable character(len=*), intent(in) :: varname !< The name of the variable to read type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data + real, optional, intent(in) :: scale !< A factor by which to rescale the array. ! Local variables integer :: nf do nf=1,size(filenames) if (LEN_TRIM(filenames(nf)) == 0) cycle if (field_exists(filenames(nf), varname, MOM_domain=G%Domain)) then - call MOM_read_data(filenames(nf), varname, array, G%Domain) + call MOM_read_data(filenames(nf), varname, array, G%Domain, scale=scale) return endif enddo @@ -571,22 +581,22 @@ end subroutine tidal_forcing_sensitivity !! height. For now, eta and eta_tidal are both geopotential heights in depth !! units, but probably the input for eta should really be replaced with the !! column mass anomalies. -subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) +subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height !! anomalies [Z ~> m]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. - real, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. ! Local variables - real :: now ! The relative time in seconds. - real :: amp_cosomegat, amp_sinomegat - real :: cosomegat, sinomegat - real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal. + real :: now ! The relative time compared with the tidal reference [T ~> s] + real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m] + real :: cosomegat, sinomegat ! The components of the phase [nondim] + real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal [nondim] integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -598,7 +608,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) return endif - now = time_type_to_real(Time - cs%time_ref) + now = US%s_to_T * time_type_to_real(Time - cs%time_ref) if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then eta_prop = 2.0*CS%SAL_SCALAR @@ -614,8 +624,8 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) do c=1,CS%nc m = CS%struct(c) - amp_cosomegat = m_to_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) - amp_sinomegat = m_to_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) + amp_cosomegat = CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) + amp_sinomegat = CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + & amp_sinomegat*CS%sin_struct(i,j,m)) @@ -626,7 +636,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) + m_to_Z*CS%ampsal(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * & (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c)) enddo ; enddo enddo ; endif @@ -635,7 +645,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) - m_to_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c)) enddo ; enddo enddo ; endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index adac9e83f4..d384500c3d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -56,12 +56,12 @@ module MOM_vert_friction !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they !! are large enough that the corresponding CFL number - !! exceeds this value, nondim. + !! exceeds this value [nondim]. real :: CFL_report !< The value of the CFL number that will cause the - !! accelerations to be reported, nondim. CFL_report + !! accelerations to be reported [nondim]. CFL_report !! will often equal CFL_trunc. real :: truncRampTime !< The time-scale over which to ramp up the value of - !! CFL_trunc from CFL_truncS to CFL_truncE + !! CFL_trunc from CFL_truncS to CFL_truncE [T ~> s] real :: CFL_truncS !< The start value of CFL_trunc real :: CFL_truncE !< The end/target value of CFL_trunc logical :: CFLrampingIsActivated = .false. !< True if the ramping has been initialized @@ -105,7 +105,7 @@ module MOM_vert_friction !! thickness for viscosity. logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the !! answers from the end of 2018. Otherwise, use expressions that do not - !! use an arbitary and hard-coded maximum viscous coupling coefficient + !! use an arbitrary and hard-coded maximum viscous coupling coefficient !! between layers. logical :: debug !< If true, write verbose checksums for debugging purposes. integer :: nkml !< The number of layers in the mixed layer. @@ -533,7 +533,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif if (associated(ADp%du_dt_str) .and. associated(ADp%dv_dt_str)) then - ! Diagnostics for thickness x wind stress acclerations + ! Diagnostics for thickness x wind stress accelerations if (CS%id_h_du_dt_str > 0) call post_product_u(CS%id_h_du_dt_str, ADp%du_dt_str, ADp%diag_hu, G, nz, CS%diag) if (CS%id_h_dv_dt_str > 0) call post_product_v(CS%id_h_dv_dt_str, ADp%dv_dt_str, ADp%diag_hv, G, nz, CS%diag) @@ -555,11 +555,11 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: visc_rem_u !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences after + !! barotropic acceleration that a layer experiences after !! viscosity is applied in the zonal direction [nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: visc_rem_v !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences after + !! barotropic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -692,7 +692,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) a_shelf, & ! The drag coefficients across interfaces in water columns under ! ice shelves [Z T-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, - ! normalized by the bottom boundary layer thickness, nondim. + ! normalized by the bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. @@ -715,10 +715,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more ! than Htbl into the interior. - real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. + real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim] real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. real :: z_clear ! The clearance of an interface above the surrounding topography [H ~> m or kg m-2]. - real :: a_cpl_max ! The maximum drag doefficient across interfaces, set so that it will be + real :: a_cpl_max ! The maximum drag coefficient across interfaces, set so that it will be ! representable as a 32-bit float in MKS units [Z T-1 ~> m s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1193,7 +1193,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_neglect = GV%H_subroundoff if (CS%answers_2018) then - ! The maximum coupling coefficent was originally introduced to avoid + ! The maximum coupling coefficient was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. I_amax = (1.0e-10*US%Z_to_m) * dt @@ -1759,7 +1759,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "CFL_TRUNCATE_RAMP_TIME", CS%truncRampTime, & "The time over which the CFL truncation value is ramped "//& "up at the beginning of the run.", & - units="s", default=0.) + units="s", default=0., scale=US%s_to_T) CS%CFL_truncE = CS%CFL_trunc call get_param(param_file, mdl, "CFL_TRUNCATE_START", CS%CFL_truncS, & "The start value of the truncation CFL number used when "//& @@ -1937,14 +1937,16 @@ end subroutine vertvisc_init !> Update the CFL truncation value as a function of time. !! If called with the optional argument activate=.true., record the !! value of Time as the beginning of the ramp period. -subroutine updateCFLtruncationValue(Time, CS, activate) +subroutine updateCFLtruncationValue(Time, CS, US, activate) type(time_type), target, intent(in) :: Time !< Current model time type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: activate !< Specify whether to record the value of !! Time as the beginning of the ramp period ! Local variables - real :: deltaTime, wghtA + real :: deltaTime ! The time since CS%rampStartTime [T ~> s], which may be negative. + real :: wghtA ! The relative weight of the final value [nondim] character(len=12) :: msg if (CS%truncRampTime==0.) return ! This indicates to ramping is turned off @@ -1958,7 +1960,7 @@ subroutine updateCFLtruncationValue(Time, CS, activate) endif endif if (.not.CS%CFLrampingIsActivated) return - deltaTime = max( 0., time_type_to_real( Time - CS%rampStartTime ) ) + deltaTime = max( 0., US%s_to_T*time_type_to_real( Time - CS%rampStartTime ) ) if (deltaTime >= CS%truncRampTime) then CS%CFL_trunc = CS%CFL_truncE CS%truncRampTime = 0. ! This turns off ramping after this call @@ -1966,7 +1968,7 @@ subroutine updateCFLtruncationValue(Time, CS, activate) wghtA = min( 1., deltaTime / CS%truncRampTime ) ! Linear profile in time !wghtA = wghtA*wghtA ! Convert linear profile to parabolic profile in time !wghtA = wghtA*wghtA*(3. - 2.*wghtA) ! Convert linear profile to cosine profile - wghtA = 1. - ( (1. - wghtA)**2 ) ! Convert linear profiel to nverted parabolic profile + wghtA = 1. - ( (1. - wghtA)**2 ) ! Convert linear profile to inverted parabolic profile CS%CFL_trunc = CS%CFL_truncS + wghtA * ( CS%CFL_truncE - CS%CFL_truncS ) endif write(msg(1:12),'(es12.3)') CS%CFL_trunc From 5d4e8a19f3322e2eb4bb4adca95ac4e3044da022 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 22 Dec 2021 11:57:14 -0500 Subject: [PATCH 119/138] (*)Removed problematic offline tracer lines Commented out the problematic lines that Andrew Shao flagged in his review of MOM6 dev/gfdl PR #37. The model runs perfectly well in short offline-tracer test runs, and even gives bitwise identical output, perhaps because no layers were being abruptly flooded to 10^13 times their previous values. These omitted lines could change answers in some cases, so the lines in question have been retained in case the offline tracer code needs to be debugged layer and these mysterious (and seemingly unhelpful) lines turn out to have been necessary. All answers in the non-offline-tracer runs are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index b5d9c38fac..1fd1e88d12 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -63,14 +63,16 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) - ! In the case that the layer is now dramatically thinner than it was previously, - ! add a bit of mass to avoid truncation errors. This will lead to - ! non-conservation of tracers - h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + ! This line was used previously, but it makes no sense, as it applies to the case of + ! wetting, not drying, and it does not seem to serve any useful purpose. Test runs + ! without this line seem to work properly, but it is being retained in a comment + ! pending verification that it is in fact unnecessary. + + ! h_new(i,j,k) = h_new(i,j,k) + & + ! max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) * G%IareaT(i,j) + h_new(i,j,k) = max(GV%Angstrom_H, h_new(i,j,k) * G%IareaT(i,j)) enddo ; enddo enddo @@ -103,18 +105,24 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) do i=is-1,ie+1 ! Top layer h_new(i,j,1) = max(0.0, h_pre(i,j,1) + ((eb(i,j,1) - ea(i,j,2)) + ea(i,j,1))) - h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) + ! h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + ((ea(i,j,nz) - eb(i,j,nz-1)) + eb(i,j,nz))) - h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) + ! h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is-1,ie+1 h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1)))) - h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) + + ! This line and its two counterparts above were used previously, but it makes no sense as + ! written because it acts in the case of wetting, not drying, and it does not seem to serve + ! any useful purpose. Test runs without these lines seem to work fine, but they are + ! being retained in comments pending verification that they are in fact unnecessary. + + ! h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo enddo From dad675ad84c966adf942c0cbb40993d589e347a6 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Dec 2021 16:01:25 -0500 Subject: [PATCH 120/138] Fix badge URL for codecov --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index d041a47daf..46774baaf0 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ [![Read The Docs Status](https://readthedocs.org/projects/mom6/badge/?badge=latest)](http://mom6.readthedocs.io/) -[![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev%2Fmaster/graph/badge.svg)](https://codecov.io/gh/NOAA-GFDL/MOM6) +[![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev/gfdl/graph/badge.svg?token=uF8SVydCdp)](https://codecov.io/gh/NOAA-GFDL/MOM6) # MOM6 From f35edbd9d5766f3a9b367ea2c8fc22b3a5bae547 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 17 Dec 2021 09:42:04 -0500 Subject: [PATCH 121/138] Bugfix - calculate density integrals in ALE mode w/ pressure_reconstruction=0 --- src/core/MOM_PressureForce_FV.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 30b2e90d1a..49cf5d6063 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -245,7 +245,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! Calculate 4 integrals through the layer that are required in the ! subsequent calculation. if (use_EOS) then - if ( use_ALE ) then + if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & p(:,:,K), p(:,:,K+1), alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & @@ -697,7 +697,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! assumed when regridding is activated. Otherwise, the previous version ! is used, whereby densities within each layer are constant no matter ! where the layers are located. - if ( use_ALE ) then + if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & From f865b249e81313773ce1226f9eb94d59a02ce3fd Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 23 Dec 2021 15:48:52 -0500 Subject: [PATCH 122/138] Update MOM_PressureForce_FV.F90 Replace `.gt.` with `>` --- src/core/MOM_PressureForce_FV.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 49cf5d6063..2a79486a5f 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -245,7 +245,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! Calculate 4 integrals through the layer that are required in the ! subsequent calculation. if (use_EOS) then - if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then + if ( use_ALE .and. CS%Recon_Scheme > 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & p(:,:,K), p(:,:,K+1), alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & @@ -697,7 +697,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! assumed when regridding is activated. Otherwise, the previous version ! is used, whereby densities within each layer are constant no matter ! where the layers are located. - if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then + if ( use_ALE .and. CS%Recon_Scheme > 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & From b628748dee57f7aa232844a5df84e05bfb8a435c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 08:23:06 -0500 Subject: [PATCH 123/138] Correct comments describing generic_tracer args Corrected uninformative comments describing the some of the arguments to the stub routines in config_src/external/GFDL_ocean_BGC/generic_tracer.F90. The updated comments are consistent with how they are used in calls to these routines and with the underlying actual generic_tracer code if they are actually documented there. The previous comments had been added to existing undocumented code to satisfy the MOM6 requirement that there be a doxygen comment describing every argument to every routine, in the hopes that someone with familiarity with the generic tracer could work amend them to something more appropriate. However, "Unknown" is neither an accurate nor an informative description, and current MOM6 standards would demand that we reject any new code contributions with such poor interface documentation. All answers are bitwise identical, and only comments have changed. --- .../GFDL_ocean_BGC/generic_tracer.F90 | 73 +++++++++++-------- 1 file changed, 41 insertions(+), 32 deletions(-) diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 index 4d2e4183f7..6bd445ae8b 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 @@ -42,7 +42,7 @@ subroutine generic_tracer_init(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid integer, intent(in) :: jsd !< Data start index in j direction integer, intent(in) :: jed !< Data end index in j direction integer, intent(in) :: nk !< Number of levels in k direction - integer, intent(in) :: ntau !< Unknown + integer, intent(in) :: ntau !< The number of tracer time levels (always 1 for MOM6) integer, intent(in) :: axes(3) !< Domain axes? type(time_type), intent(in) :: init_time !< Time real, dimension(:,:,:),target, intent(in) :: grid_tmask !< Mask @@ -61,7 +61,7 @@ end subroutine generic_tracer_coupler_get !> Unknown subroutine generic_tracer_coupler_accumulate(IOB_struc, weight, model_time) type(coupler_2d_bc_type), intent(in) :: IOB_struc !< Ice Ocean Boundary flux structure - real, intent(in) :: weight !< Unknown + real, intent(in) :: weight !< A weight for accumulating these fluxes type(time_type), optional,intent(in) :: model_time !< Time end subroutine generic_tracer_coupler_accumulate @@ -69,44 +69,53 @@ end subroutine generic_tracer_coupler_accumulate subroutine generic_tracer_source(Temp,Salt,rho_dzt,dzt,hblt_depth,ilb,jlb,tau,dtts,& grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,& frunoff,grid_ht, current_wave_stress, sosga) - real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] - real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] - real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Unknown - real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] - real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth - integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain - integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain - integer, intent(in) :: tau !< Time step index of %field - real, intent(in) :: dtts !< Unknown - real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Unknown + real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] + real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] + real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Mass per unit area of each layer [kg m-2] + real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] + real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth [m] + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + integer, intent(in) :: tau !< Time step index of %field + real, intent(in) :: dtts !< The time step for this call [s] + real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Grid cell areas [m2] type(time_type), intent(in) :: model_time !< Time - integer, intent(in) :: nbands !< Unknown - real, dimension(:), intent(in) :: max_wavelength_band !< Unknown - real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Shortwave penetration - real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown - real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown - real, optional , intent(in) :: sosga !< Global average sea surface salinity + integer, intent(in) :: nbands !< The number of bands of penetrating shortwave radiation + real, dimension(:), intent(in) :: max_wavelength_band !< The maximum wavelength in each band + !! of penetrating shortwave radiation [nm] + real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Penetrating shortwave radiation per band [W m-2]. + !! The wavelength or angular direction band is the first index. + real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Opacity of seawater averaged over each band [m-1]. + !! The wavelength or angular direction band is the first index. + real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Any internal or geothermal heat + !! sources that are applied to the ocean integrated + !! over this timestep [degC kg m-2] + real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Rate of iceberg calving [kg m-2 s-1] + real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown, and presently unused by MOM6 + real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown, and presently unused by MOM6 + real, optional , intent(in) :: sosga !< Global average sea surface salinity [ppt] end subroutine generic_tracer_source !> Update the tracers from bottom fluxes subroutine generic_tracer_update_from_bottom(dt, tau, model_time) - real, intent(in) :: dt !< Time step increment + real, intent(in) :: dt !< Time step increment [s] integer, intent(in) :: tau !< Time step index used for the concentration field type(time_type), intent(in) :: model_time !< Time end subroutine generic_tracer_update_from_bottom !> Vertically diffuse all generic tracers for GOLD ocean subroutine generic_tracer_vertdiff_G(h_old, ea, eb, dt, kg_m2_to_H, m_to_H, tau) - real, dimension(:,:,:), intent(in) :: h_old !< Unknown - real, dimension(:,:,:), intent(in) :: ea !< Unknown - real, dimension(:,:,:), intent(in) :: eb !< Unknown - real, intent(in) :: dt !< Unknown - real, intent(in) :: kg_m2_to_H !< Unknown - real, intent(in) :: m_to_H !< Unknown - integer, intent(in) :: tau !< Unknown + real, dimension(:,:,:), intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: ea !< The amount of fluid entrained from the layer + !! above during this call [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: eb !< The amount of fluid entrained from the layer + !! below during this call [H ~> m or kg m-2] + real, intent(in) :: dt !< The amount of time covered by this call [s] + real, intent(in) :: kg_m2_to_H !< A unit conversion factor from mass per unit + !! area to thickness units [H m2 kg-1 ~> m3 kg-1 or 1] + real, intent(in) :: m_to_H !< A unit conversion factor from heights to + !! thickness units [H m-1 ~> 1 or kg m-3] + integer, intent(in) :: tau !< The time level to work on (always 1 for MOM6) end subroutine generic_tracer_vertdiff_G !> Set the coupler values for each generic tracer @@ -115,11 +124,11 @@ subroutine generic_tracer_coupler_set(IOB_struc, ST,SS,rho,ilb,jlb,tau, dzt, sos integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain integer, intent(in) :: tau !< Time step index of %field - real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [deg C] - real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [psu] + real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [degC] + real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [ppt] real, dimension(ilb:,jlb:,:,:), intent(in) :: rho !< Ocean density [kg m-3] real, dimension(ilb:,jlb:,:), optional, intent(in) :: dzt !< Layer thickness [m] - real, optional, intent(in) :: sosga !< Unknown + real, optional, intent(in) :: sosga !< Global mean sea surface salinity [ppt] type(time_type),optional, intent(in) :: model_time !< Time end subroutine generic_tracer_coupler_set From 6bcea76f917d126da5976564cc347b1fd36ab41c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Dec 2021 15:48:55 -0500 Subject: [PATCH 124/138] Fixes an uninitialized logical in FMS_cap - A do_not_log depends on a logical that is only set conditionally. This initializes that logical when the corresponding parameter is not being read. - Unfortunately, this change MOM_parameter_doc.all for the coupled models. The .all pipeline uses the gnu compiler which was initializing this logical as .true. and thus logging the new parameter when it should not have been. Intel and PGI were initializing with .false. --- config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index cab870fed4..acbbc292de 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -1461,6 +1461,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) call get_param(param_file, mdl, "SPEAR_ECDA_SST_RESTORE_TFREEZE", CS%trestore_SPEAR_ECDA, & "If true, modify SST restoring field using SSS state. This only modifies the "//& "restoring data that is within 0.0001degC of -1.8degC.", default=.false.) + else + CS%trestore_SPEAR_ECDA = .false. ! Needed to toggle logging of SPEAR_DTFREEZE_DS endif call get_param(param_file, mdl, "SPEAR_DTFREEZE_DS", CS%SPEAR_dTf_dS, & "The derivative of the freezing temperature with salinity.", & From d9d82e325f96229e04240a563e7465b03528747e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 23 Dec 2021 10:48:36 -0500 Subject: [PATCH 125/138] Eliminate unneeded diagnostic arrays in CorAdCalc Eliminated 4 unnecessary 3-d allocatable arrays and 8 2-d diagnostic arrays in CorAdCalc, and simplified the code calculating these diagnostics by using the post_product_[uv] and post_product_sum_[uv] routines. Also grouped the calls that allocate the memory that is still needed for diagnostics. This commit also includes a few other minor changes to clean up the documentation of variable intents and unit documentation in a handful of other places in the code: - Add intent declarations to the arguments to chksum2d() and chksum3d() - Corrected incorrect scale arguments for two (untested) checksum calls. - Corrected the documented units in several comments. All answers and output are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 311 ++++-------------- src/framework/MOM_checksums.F90 | 8 +- .../MOM_state_initialization.F90 | 2 +- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 2 +- src/user/ISOMIP_initialization.F90 | 4 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 2 +- 8 files changed, 80 insertions(+), 253 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 953d64c1f0..19f14ceac3 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -6,6 +6,8 @@ module MOM_CoriolisAdv !> \author Robert Hallberg, April 1994 - June 2002 use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type @@ -119,7 +121,7 @@ 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, pbv) - type(ocean_grid_type), intent(in) :: G !< Ocen grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean 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] @@ -223,25 +225,6 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) real :: QUHeff,QVHeff ! More temporary variables [H L2 T-2 ~> m3 s-2 or kg s-2]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz -! Diagnostics for fractional thickness-weighted terms - real, allocatable, dimension(:,:) :: & - hf_gKEu_2d, hf_gKEv_2d, & ! Depth sum of hf_gKEu, hf_gKEv [L T-2 ~> m s-2]. - hf_rvxu_2d, hf_rvxv_2d ! Depth sum of hf_rvxu, hf_rvxv [L T-2 ~> m s-2]. - - !real, allocatable, dimension(:,:,:) :: & - ! hf_gKEu, hf_gKEv, & ! accel. due to KE gradient x fract. thickness [L T-2 ~> m s-2]. - ! hf_rvxu, hf_rvxv ! accel. due to RV x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_gKEu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - -! Diagnostics for thickness multiplied momentum budget terms - real, allocatable, dimension(:,:,:) :: h_gKEu, h_gKEv ! h x gKEu, h x gKEv [H L T-2 ~> m2 s-2]. - real, allocatable, dimension(:,:,:) :: h_rvxv, h_rvxu ! h x rvxv, h x rvxu [H L T-2 ~> m2 s-2]. - -! Diagnostics for depth-integrated momentum budget terms - real, dimension(SZIB_(G),SZJ_(G)) :: intz_gKEu_2d, intz_rvxv_2d ! [H L T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJB_(G)) :: intz_gKEv_2d, intz_rvxu_2d ! [H L T-2 ~> m2 s-2]. - ! To work, the following fields must be set outside of the usual ! is to ie range before this subroutine is called: ! v(is-1:ie+2,js-1:je+1), u(is-1:ie+1,js-1:je+2), h(is-1:ie+2,js-1:je+2), @@ -877,147 +860,26 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) ! 3D diagnostics hf_gKEu etc. are commented because there is no clarity on proper remapping grid option. ! The code is retained for debugging purposes in the future. - !if (CS%id_hf_gKEu > 0) then - ! 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 - ! call post_data(CS%id_hf_gKEu, hf_gKEu, CS%diag) - !endif - - !if (CS%id_hf_gKEv > 0) then - ! 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 - ! call post_data(CS%id_hf_gKEv, hf_gKEv, CS%diag) - !endif - - if (CS%id_hf_gKEu_2d > 0) then - allocate(hf_gKEu_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_gKEu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_gKEu_2d(I,j) = hf_gKEu_2d(I,j) + AD%gradKEu(I,j,k) * AD%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_gKEu_2d, hf_gKEu_2d, CS%diag) - deallocate(hf_gKEu_2d) - endif - - if (CS%id_hf_gKEv_2d > 0) then - allocate(hf_gKEv_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_gKEv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_gKEv_2d(i,J) = hf_gKEv_2d(i,J) + AD%gradKEv(i,J,k) * AD%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_gKEv_2d, hf_gKEv_2d, CS%diag) - deallocate(hf_gKEv_2d) - endif - - if (CS%id_intz_gKEu_2d > 0) then - intz_gKEu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_gKEu_2d(I,j) = intz_gKEu_2d(I,j) + AD%gradKEu(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_gKEu_2d, intz_gKEu_2d, CS%diag) - endif - - if (CS%id_intz_gKEv_2d > 0) then - intz_gKEv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_gKEv_2d(i,J) = intz_gKEv_2d(i,J) + AD%gradKEv(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_gKEv_2d, intz_gKEv_2d, CS%diag) - endif - - !if (CS%id_hf_rvxv > 0) then - ! 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 - ! call post_data(CS%id_hf_rvxv, hf_rvxv, CS%diag) - !endif - - !if (CS%id_hf_rvxu > 0) then - ! 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 - ! call post_data(CS%id_hf_rvxu, hf_rvxu, CS%diag) - !endif - - if (CS%id_hf_rvxv_2d > 0) then - allocate(hf_rvxv_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_rvxv_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_rvxv_2d(I,j) = hf_rvxv_2d(I,j) + AD%rv_x_v(I,j,k) * AD%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_rvxv_2d, hf_rvxv_2d, CS%diag) - deallocate(hf_rvxv_2d) - endif - - if (CS%id_hf_rvxu_2d > 0) then - allocate(hf_rvxu_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_rvxu_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_rvxu_2d(i,J) = hf_rvxu_2d(i,J) + AD%rv_x_u(i,J,k) * AD%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_rvxu_2d, hf_rvxu_2d, CS%diag) - deallocate(hf_rvxu_2d) - endif - - if (CS%id_h_gKEu > 0) then - allocate(h_gKEu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_gKEu(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_gKEu(I,j,k) = AD%gradKEu(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_gKEu, h_gKEu, CS%diag) - deallocate(h_gKEu) - endif - if (CS%id_h_gKEv > 0) then - allocate(h_gKEv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_gKEv(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_gKEv(i,J,k) = AD%gradKEv(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_gKEv, h_gKEv, CS%diag) - deallocate(h_gKEv) - endif - - if (CS%id_h_rvxv > 0) then - allocate(h_rvxv(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_rvxv(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_rvxv(I,j,k) = AD%rv_x_v(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_rvxv, h_rvxv, CS%diag) - deallocate(h_rvxv) - endif - if (CS%id_h_rvxu > 0) then - allocate(h_rvxu(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_rvxu(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_rvxu(i,J,k) = AD%rv_x_u(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_rvxu, h_rvxu, CS%diag) - deallocate(h_rvxu) - endif - - if (CS%id_intz_rvxv_2d > 0) then - intz_rvxv_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_rvxv_2d(I,j) = intz_rvxv_2d(I,j) + AD%rv_x_v(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_rvxv_2d, intz_rvxv_2d, CS%diag) - endif - - if (CS%id_intz_rvxu_2d > 0) then - intz_rvxu_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_rvxu_2d(i,J) = intz_rvxu_2d(i,J) + AD%rv_x_u(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_rvxu_2d, intz_rvxu_2d, CS%diag) - endif + ! if (CS%id_hf_gKEu > 0) call post_product_u(CS%id_hf_gKEu, AD%gradKEu, AD%diag_hfrac_u, G, nz, CS%diag) + ! if (CS%id_hf_gKEv > 0) call post_product_v(CS%id_hf_gKEv, AD%gradKEv, AD%diag_hfrac_v, G, nz, CS%diag) + ! if (CS%id_hf_rvxv > 0) call post_product_u(CS%id_hf_rvxv, AD%rv_x_v, AD%diag_hfrac_u, G, nz, CS%diag) + ! if (CS%id_hf_rvxu > 0) call post_product_v(CS%id_hf_rvxu, AD%rv_x_u, AD%diag_hfrac_v, G, nz, CS%diag) + + if (CS%id_hf_gKEu_2d > 0) call post_product_sum_u(CS%id_hf_gKEu_2d, AD%gradKEu, AD%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_gKEv_2d > 0) call post_product_sum_v(CS%id_hf_gKEv_2d, AD%gradKEv, AD%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_intz_gKEu_2d > 0) call post_product_sum_u(CS%id_intz_gKEu_2d, AD%gradKEu, AD%diag_hu, G, nz, CS%diag) + if (CS%id_intz_gKEv_2d > 0) call post_product_sum_v(CS%id_intz_gKEv_2d, AD%gradKEv, AD%diag_hv, G, nz, CS%diag) + + if (CS%id_hf_rvxv_2d > 0) call post_product_sum_u(CS%id_hf_rvxv_2d, AD%rv_x_v, AD%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_rvxu_2d > 0) call post_product_sum_v(CS%id_hf_rvxu_2d, AD%rv_x_u, AD%diag_hfrac_v, G, nz, CS%diag) + + if (CS%id_h_gKEu > 0) call post_product_u(CS%id_h_gKEu, AD%gradKEu, AD%diag_hu, G, nz, CS%diag) + if (CS%id_h_gKEv > 0) call post_product_v(CS%id_h_gKEv, AD%gradKEv, AD%diag_hv, G, nz, CS%diag) + if (CS%id_h_rvxv > 0) call post_product_u(CS%id_h_rvxv, AD%rv_x_v, AD%diag_hu, G, nz, CS%diag) + if (CS%id_h_rvxu > 0) call post_product_v(CS%id_h_rvxu, AD%rv_x_u, AD%diag_hv, G, nz, CS%diag) + + if (CS%id_intz_rvxv_2d > 0) call post_product_sum_u(CS%id_intz_rvxv_2d, AD%rv_x_v, AD%diag_hu, G, nz, CS%diag) + if (CS%id_intz_rvxu_2d > 0) call post_product_sum_v(CS%id_intz_rvxu_2d, AD%rv_x_u, AD%diag_hv, G, nz, CS%diag) endif end subroutine CorAdCalc @@ -1259,146 +1121,111 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) CS%id_gKEu = register_diag_field('ocean_model', 'gKEu', diag%axesCuL, Time, & 'Zonal Acceleration from Grad. Kinetic Energy', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_gKEu > 0) call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) CS%id_gKEv = register_diag_field('ocean_model', 'gKEv', diag%axesCvL, Time, & 'Meridional Acceleration from Grad. Kinetic Energy', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_gKEv > 0) call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) CS%id_rvxu = register_diag_field('ocean_model', 'rvxu', diag%axesCvL, Time, & 'Meridional Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_rvxu > 0) call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) CS%id_rvxv = register_diag_field('ocean_model', 'rvxv', diag%axesCuL, Time, & 'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_gKEu > 0) then - ! call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif - - !CS%id_hf_gKEv = register_diag_field('ocean_model', 'hf_gKEv', diag%axesCvL, Time, & - ! 'Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & - ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_gKEv > 0) then - ! call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif - CS%id_hf_gKEu_2d = register_diag_field('ocean_model', 'hf_gKEu_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_gKEu_2d > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif + !CS%id_hf_gKEv = register_diag_field('ocean_model', 'hf_gKEv', diag%axesCvL, Time, & + ! 'Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & + ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_gKEv_2d = register_diag_field('ocean_model', 'hf_gKEv_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_gKEv_2d > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif CS%id_h_gKEu = register_diag_field('ocean_model', 'h_gKEu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_gKEu > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif - CS%id_intz_gKEu_2d = register_diag_field('ocean_model', 'intz_gKEu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_gKEu_2d > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_gKEv = register_diag_field('ocean_model', 'h_gKEv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_gKEv > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif - CS%id_intz_gKEv_2d = register_diag_field('ocean_model', 'intz_gKEv_2d', diag%axesCv1, Time, & 'Depth-integral of Meridional Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_gKEv_2d > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif !CS%id_hf_rvxu = register_diag_field('ocean_model', 'hf_rvxu', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_rvxu > 0) then - ! call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif - - !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & - ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & - ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_rvxv > 0) then - ! call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif - CS%id_hf_rvxu_2d = register_diag_field('ocean_model', 'hf_rvxu_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_rvxu_2d > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif + !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & + ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & + ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_rvxv_2d = register_diag_field('ocean_model', 'hf_rvxv_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_rvxv_2d > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_rvxu = register_diag_field('ocean_model', 'h_rvxu', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_rvxu > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif - CS%id_intz_rvxu_2d = register_diag_field('ocean_model', 'intz_rvxu_2d', diag%axesCv1, Time, & 'Depth-integral of Meridional Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_rvxu_2d > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif CS%id_h_rvxv = register_diag_field('ocean_model', 'h_rvxv', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_rvxv > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif - CS%id_intz_rvxv_2d = register_diag_field('ocean_model', 'intz_rvxv_2d', diag%axesCu1, Time, & 'Depth-integral of Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_rvxv_2d > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) + + ! Allocate memory needed for the diagnostics that have been enabled. + if ((CS%id_gKEu > 0) .or. (CS%id_hf_gKEu_2d > 0) .or. & + ! (CS%id_hf_gKEu > 0) .or. & + (CS%id_h_gKEu > 0) .or. (CS%id_intz_gKEu_2d > 0)) then + call safe_alloc_ptr(AD%gradKEu, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_gKEv > 0) .or. (CS%id_hf_gKEv_2d > 0) .or. & + ! (CS%id_hf_gKEv > 0) .or. & + (CS%id_h_gKEv > 0) .or. (CS%id_intz_gKEv_2d > 0)) then + call safe_alloc_ptr(AD%gradKEv, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_rvxu > 0) .or. (CS%id_hf_rvxu_2d > 0) .or. & + ! (CS%id_hf_rvxu > 0) .or. & + (CS%id_h_rvxu > 0) .or. (CS%id_intz_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%rv_x_u, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_rvxv > 0) .or. (CS%id_hf_rvxv_2d > 0) .or. & + ! (CS%id_hf_rvxv > 0) .or. & + (CS%id_h_rvxv > 0) .or. (CS%id_intz_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%rv_x_v, IsdB, IedB, jsd, jed, nz) + endif + + if ((CS%id_hf_gKEv_2d > 0) .or. & + ! (CS%id_hf_gKEv > 0) .or. (CS%id_hf_rvxu > 0) .or. & + (CS%id_hf_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%diag_hfrac_v, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_hf_gKEu_2d > 0) .or. & + ! (CS%id_hf_gKEu > 0) .or. (CS%id_hf_rvxv > 0) .or. & + (CS%id_hf_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%diag_hfrac_u, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_h_gKEu > 0) .or. (CS%id_intz_gKEu_2d > 0) .or. & + (CS%id_h_rvxv > 0) .or. (CS%id_intz_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%diag_hu, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_h_gKEv > 0) .or. (CS%id_intz_gKEv_2d > 0) .or. & + (CS%id_h_rvxu > 0) .or. (CS%id_intz_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%diag_hv, isd, ied, JsdB, JedB, nz) endif end subroutine CoriolisAdv_init diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 718a796802..fffdb9bed8 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -1944,8 +1944,8 @@ end subroutine chksum1d !> chksum2d does a checksum of all data in a 2-d array. subroutine chksum2d(array, mesg) - real, dimension(:,:) :: array !< The array to be checksummed - character(len=*) :: mesg !< An identifying message + real, dimension(:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,i,j,sum1,bc real :: sum @@ -1972,8 +1972,8 @@ end subroutine chksum2d !> chksum3d does a checksum of all data in a 2-d array. subroutine chksum3d(array, mesg) - real, dimension(:,:,:) :: array !< The array to be checksummed - character(len=*) :: mesg !< An identifying message + real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,zs,ze,i,j,k, bc,sum1 real :: sum diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 8055440cce..0d5342d9be 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -442,7 +442,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (new_sim) call pass_vector(u, v, G%Domain) if (debug .and. new_sim) then - call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 6b44fce15e..fd2fe78907 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -275,7 +275,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) ! if (CS%id_kd_conv > 0) & ! call hchksum(Kd_conv, "MOM_CVMix_conv: Kd_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) ! if (CS%id_kv_conv > 0) & - ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%m2_s_to_Z2_T) + ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index f7d4b0cc0d..350f73d164 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1191,7 +1191,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the ! interior layer layer times the depth of the the mixed layer - ! [H2 Z2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. + ! [H2 L2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 2ebac05a68..7386a008e6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -42,9 +42,9 @@ module ISOMIP_initialization subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m ~> Z] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth [m ~> Z] + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 4c0c55f746..d1c89f14f3 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -119,7 +119,7 @@ end subroutine Kelvin_OBC_end subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m ~> Z] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 110a12c5f5..db1b512ca9 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -325,7 +325,7 @@ end function sech subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m ~> Z] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type From 5ad8a2cd14716a50659317f7b1ca656b93a35a15 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 29 Dec 2021 08:32:32 -0500 Subject: [PATCH 126/138] Deleted commented out offline tracer lines Deleted four lines in the offline tracer code that had recently been commented out, along with the comments describing them. Further conversations had led to a consensus that these lines served no useful purpose, and are not worth keeping in the code, even in comments. Several excess spaces were also eliminated in MOM_offline_aux.F90. All answers and output are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 31 +++++++------------------------ 1 file changed, 7 insertions(+), 24 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 1fd1e88d12..bdd6be4fe0 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -55,7 +55,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do k=1,nz do i=is-1,ie+1 ; do j=js-1,je+1 @@ -63,14 +63,6 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) - ! This line was used previously, but it makes no sense, as it applies to the case of - ! wetting, not drying, and it does not seem to serve any useful purpose. Test runs - ! without this line seem to work properly, but it is being retained in a comment - ! pending verification that it is in fact unnecessary. - - ! h_new(i,j,k) = h_new(i,j,k) + & - ! max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) - ! Convert back to thickness h_new(i,j,k) = max(GV%Angstrom_H, h_new(i,j,k) * G%IareaT(i,j)) @@ -98,31 +90,22 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Update h_new with convergence of vertical mass transports do j=js-1,je+1 do i=is-1,ie+1 ! Top layer h_new(i,j,1) = max(0.0, h_pre(i,j,1) + ((eb(i,j,1) - ea(i,j,2)) + ea(i,j,1))) - ! h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + ((ea(i,j,nz) - eb(i,j,nz-1)) + eb(i,j,nz))) - ! h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is-1,ie+1 h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1)))) - - ! This line and its two counterparts above were used previously, but it makes no sense as - ! written because it acts in the case of wetting, not drying, and it does not seem to serve - ! any useful purpose. Test runs without these lines seem to work fine, but they are - ! being retained in comments pending verification that they are in fact unnecessary. - - ! h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo enddo @@ -165,7 +148,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! Hence, uh(I-1) is multipled by negative one, but uh(I) is not ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Calculate top and bottom fluxes from ea and eb. Note the explicit negative signs ! to enforce the positive out convention @@ -247,7 +230,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do j=js,je uh2d_sum(:) = 0.0 @@ -326,7 +309,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do i=is,ie vh2d_sum(:) = 0.0 @@ -403,7 +386,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h = GV%Angstrom_H*0.1 @@ -502,7 +485,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h = 0.1*GV%Angstrom_H From 2b2214d9b432071cbb2e7fd2d5d11a9395c32e62 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 23 Dec 2021 11:24:13 -0500 Subject: [PATCH 127/138] (*)Use por_face_area in zonal_face_thickness Use the por_face_area[UV] in the effective thickness calculations in zonal_face_thickness and merid_face_thickness, so that they are more consistent with their use elsewhere in the code for the relative weights in calculating the barotropic accelerations. Because these por_face_area arrays are still 1 in all test cases, the answers are unchanged in any test cases from before a few weeks ago, but there could be answer changes in cases that are using the very recently added capability (in PR #3) to set fractional face areas. This change was discussed with Sam Ditkovsky, and agreed that there is no reason to keep the ability to recover the previous answers in any cases that use the recently added partial face width option. This commit also expanded the comments describing the h_u and h_v arguments to btcalc(), zonal_face_thickness(), and merid_face_thickness() routines, the diag_h[uv] elements of the accel_diag_ptrs type and the h_u and h_v elements of the BT_cont_type. All answers and output are bitwise identical in the MOM6-examples test suite and TC tests, but answer changes are possible in cases using a very recently added code option. --- src/core/MOM_barotropic.F90 | 20 ++++++++++++----- src/core/MOM_continuity_PPM.F90 | 39 +++++++++++++++++++------------- src/core/MOM_variables.F90 | 40 ++++++++++++++++++++------------- 3 files changed, 63 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index a7e8194a84..3cb1ebf399 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3274,9 +3274,19 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure 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]. + optional, intent(in) :: h_u !< The specified effective thicknesses at u-points, + !! perhaps scaled down to account for viscosity and + !! fractional open areas [H ~> m or kg m-2]. These + !! are used here as non-normalized weights for each + !! layer that are converted the normalized weights + !! for determining the barotropic accelerations. 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]. + optional, intent(in) :: h_v !< The specified effective thicknesses at v-points, + !! perhaps scaled down to account for viscosity and + !! fractional open areas [H ~> m or kg m-2]. These + !! are used here as non-normalized weights for each + !! layer that are converted the normalized weights + !! for determining the barotropic accelerations. logical, optional, intent(in) :: may_use_default !< An optional logical argument !! to indicate that the default velocity point !! thicknesses may be used for this particular @@ -3296,9 +3306,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: wt_arith ! The weight for the arithmetic mean thickness [nondim]. ! The harmonic mean uses a weight of (1 - wt_arith). - real :: Rh ! A ratio of summed thicknesses, nondim. - 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 :: Rh ! A ratio of summed thicknesses [nondim] + real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity points [H ~> m or kg m-2] + real :: e_v(SZI_(G),SZK_(GV)+1) ! The interface heights at v-velocity points [H ~> m or kg m-2] real :: D_shallow_u(SZI_(G)) ! The height of the shallower of the adjacent bathymetric depths ! around a u-point (positive upward) [H ~> m or kg m-2] real :: D_shallow_v(SZIB_(G))! The height of the shallower of the adjacent bathymetric depths diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 7bc67e2fdf..95de2fd923 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -604,7 +604,8 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & endif end subroutine zonal_flux_layer -!> Sets the effective interface thickness at each zonal velocity point. +!> Sets the effective interface thickness at each zonal velocity point, optionally scaling +!! back these thicknesses to account for viscosity and fractional open areas. subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, & marginal, OBC, por_face_areaU, visc_rem_u) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. @@ -616,7 +617,10 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, !! 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(SZIB_(G),SZJ_(G),SZK_(GV)), 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 !< Effective thickness at zonal faces, + !! scaled down to account for the effects of + !! viscoity and the fractional open area + !! [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. @@ -672,11 +676,12 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else ; h_u(I,j,k) = h_avg ; endif enddo ; enddo ; enddo if (present(visc_rem_u)) then - !### The expression setting h_u should also be multiplied by por_face_areaU in this case, - ! and in the two OBC cases below with visc_rem_u. + ! Scale back the thickness to account for the effects of viscosity and the fractional open + ! thickness to give an appropriate non-normalized weight for each layer in determining the + ! barotropic acceleration. !$OMP parallel do default(shared) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh - h_u(I,j,k) = h_u(I,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) + h_u(I,j,k) = h_u(I,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo ; enddo ; enddo endif @@ -689,7 +694,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_E) then if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) + h_u(I,j,k) = h(i,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -699,7 +704,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i+1,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) + h_u(I,j,k) = h(i+1,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -1427,19 +1432,22 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & endif end subroutine merid_flux_layer -!> Sets the effective interface thickness at each meridional velocity point. +!> Sets the effective interface thickness at each meridional velocity point, optionally scaling +!! back these thicknesses to account for viscosity and fractional open areas. subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, & marginal, OBC, por_face_areaV, visc_rem_v) 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),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_(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),SZJB_(G),SZK_(GV)), intent(inout) :: h_v !< Thickness at meridional faces, + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: h_v !< Effective thickness at meridional faces, + !! scaled down to account for the effects of + !! viscoity and the fractional open area !! [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -1497,11 +1505,12 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, enddo ; enddo ; enddo if (present(visc_rem_v)) then - !### This expression setting h_v should also be multiplied by por_face_areaU in this case, - ! and in the two OBC cases below with visc_rem_u. + ! Scale back the thickness to account for the effects of viscosity and the fractional open + ! thickness to give an appropriate non-normalized weight for each layer in determining the + ! barotropic acceleration. !$OMP parallel do default(shared) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh - h_v(i,J,k) = h_v(i,J,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) + h_v(i,J,k) = h_v(i,J,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo ; enddo ; enddo endif @@ -1514,7 +1523,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_N) then if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) + h_v(i,J,k) = h(i,j,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied @@ -1524,7 +1533,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j+1,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) + h_v(i,J,k) = h(i,j+1,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 5de7ea7319..ba5001e427 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -193,13 +193,15 @@ module MOM_variables real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [L T-2 ~> m s-2] real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [L T-2 ~> m s-2] - real, pointer :: diag_hfrac_u(:,:,:) => NULL() !< Fractional layer thickness at u points - real, pointer :: diag_hfrac_v(:,:,:) => NULL() !< Fractional layer thickness at v points - real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points - real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points + real, pointer :: diag_hfrac_u(:,:,:) => NULL() !< Fractional layer thickness at u points [nondim] + real, pointer :: diag_hfrac_v(:,:,:) => NULL() !< Fractional layer thickness at v points [nondim] + real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points, modulated by the viscous + !! remnant and fractional open areas [H ~> m or kg m-2] + real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points, modulated by the viscous + !! remnant and fractional open areas [H ~> m or kg m-2] - real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points - real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points + real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points [nondim] + real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points [nondim] end type accel_diag_ptrs @@ -283,10 +285,10 @@ module MOM_variables !! drawing from nearby to the west [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the west [H L ~> m2 or kg m-1]. - real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_u_WW. uBT_WW must be non-negative. - real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_u_EE. uBT_EE must be non-positive. + real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_u_WW. uBT_WW must be non-negative. + real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport @@ -295,12 +297,18 @@ module MOM_variables !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the south [H L ~> m2 or kg m-1]. - real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_v_SS. vBT_SS must be non-negative. - real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_v_NN. vBT_NN must be non-positive. - real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces [H ~> m or kg m-2]. - real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2]. + real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_v_SS. vBT_SS must be non-negative. + real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_v_NN. vBT_NN must be non-positive. + real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces, taking into account the effects + !! of vertical viscosity and fractional open areas [H ~> m or kg m-2]. + !! This is primarily used as a non-normalized weight in determining + !! the depth averaged accelerations for the barotropic solver. + real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces, taking into account the effects + !! of vertical viscosity and fractional open areas [H ~> m or kg m-2]. + !! This is primarily used as a non-normalized weight in determining + !! the depth averaged accelerations for the barotropic solver. type(group_pass_type) :: pass_polarity_BT !< Structure for polarity group halo updates type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates end type BT_cont_type From 2d3263108d677d12d6511301aa1537483060d4b5 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Sun, 2 Jan 2022 23:07:28 -0500 Subject: [PATCH 128/138] Option to homogenize forces and fluxes (#51) * Adds option to homogenize forces and fluxes fields - Adds functions to do global averages on U and V grids in MOM_spatial_means - Adds functionality to average all forcing and fluxes fields in MOM_forcing_types - Adds flag to average all forcing and fluxes in MOM.F90 - This new feature is primarily for running in single column like configurations with the coupler, which requires perfectly equal forcing across all cells. * Fixing ustar calculation in homogenize_mech_forcing - Adds in irho0 and sqrt that were missing in homogenize mech forcing. * Updates to homogenize_forcings options. - Correct issues in global_area_mean_u and global_area_mean_v to work with symmetric and rotated grids. - Add options to compute mean ustar or compute ustar from mean tau. - Add subroutines to replace averaging blocks in MOM_forcing_type. * Minor formatting updates - Move a division and reformat alignment in MOM_spatial_means.F90. - Remove a unused parameter in MOM_forcing_type.F90 - Reformat misalignment of an "if-block" in MOM_forcing_type.F90 * Remove obsolete netSalt flux homogenization - netSalt has been removed so no longer needs homogenized in the fluxes. * Fix 2d mean on U grid to use U mask * Remove whitespacace * Add do_not_log option to UPDATE_USTAR get_param --- src/core/MOM.F90 | 26 +++ src/core/MOM_forcing_type.F90 | 231 ++++++++++++++++++++++++++ src/diagnostics/MOM_spatial_means.F90 | 46 ++++- 3 files changed, 302 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ab6380f90a..b16681156b 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -82,6 +82,8 @@ module MOM use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_forcing_type, only : deallocate_mech_forcing, deallocate_forcing_type use MOM_forcing_type, only : rotate_forcing, rotate_mech_forcing +use MOM_forcing_type, only : copy_common_forcing_fields, set_derived_forcing_fields +use MOM_forcing_type, only : homogenize_forcing, homogenize_mech_forcing use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init @@ -207,6 +209,8 @@ module MOM type(ocean_grid_type) :: G_in !< Input grid metric type(ocean_grid_type), pointer :: G => NULL() !< Model grid metric logical :: rotate_index = .false. !< True if index map is rotated + logical :: homogenize_forcings = .false. !< True if all inputs are homogenized + logical :: update_ustar = .false. !< True to update ustar from homogenized tau type(verticalGrid_type), pointer :: & GV => NULL() !< structure containing vertical grid info @@ -579,6 +583,20 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS fluxes => fluxes_in endif + ! Homogenize the forces + if (CS%homogenize_forcings) then + ! Homogenize all forcing and fluxes fields. + call homogenize_mech_forcing(forces, G, US, GV%Rho0, CS%update_ustar) + ! Note the following computes the mean ustar as the mean of ustar rather than + ! ustar of the mean of tau. + call homogenize_forcing(fluxes, G) + if (CS%update_ustar) then + ! These calls corrects the ustar values + call copy_common_forcing_fields(forces, fluxes, G) + call set_derived_forcing_fields(forces, fluxes, G, US, GV%Rho0) + endif + endif + ! First determine the time step that is consistent with this call and an ! integer fraction of time_interval. if (do_dyn) then @@ -2144,6 +2162,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("MOM parameters read (initialize_MOM)") + call get_param(param_file, "MOM", "HOMOGENIZE_FORCINGS", CS%homogenize_forcings, & + "If True, homogenize the forces and fluxes.", default=.false.) + call get_param(param_file, "MOM", "UPDATE_USTAR",CS%update_ustar, & + "If True, update ustar from homogenized tau when using the "//& + "HOMOGENIZE_FORCINGS option. Note that this will not work "//& + "with a non-zero gustiness factor.", default=.false., & + do_not_log=.not.CS%homogenize_forcings) + ! Grid rotation test call get_param(param_file, "MOM", "ROTATE_INDEX", CS%rotate_index, & "Enable rotation of the horizontal indices.", default=.false., & diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index c58340c498..3248c09fa4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -17,6 +17,7 @@ module MOM_forcing_type use MOM_grid, only : ocean_grid_type use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands use MOM_spatial_means, only : global_area_integral, global_area_mean +use MOM_spatial_means, only : global_area_mean_u, global_area_mean_v use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -35,6 +36,7 @@ module MOM_forcing_type public set_derived_forcing_fields, copy_back_forcing_fields public set_net_mass_forcing, get_net_mass_forcing public rotate_forcing, rotate_mech_forcing +public homogenize_forcing, homogenize_mech_forcing !> Allocate the fields of a (flux) forcing type, based on either a set of input !! flags for each group of fields, or a pre-allocated reference forcing. @@ -3358,6 +3360,7 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) if (do_iceberg) then call rotate_array(fluxes_in%ustar_berg, turns, fluxes%ustar_berg) call rotate_array(fluxes_in%area_berg, turns, fluxes%area_berg) + !BGR: pretty sure the following line isn't supposed to be here. call rotate_array(fluxes_in%iceshelf_melt, turns, fluxes%iceshelf_melt) endif @@ -3463,6 +3466,234 @@ subroutine rotate_mech_forcing(forces_in, turns, forces) forces%initialized = forces_in%initialized end subroutine rotate_mech_forcing +!< Homogenize the forcing fields from the input domain +subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) + type(mech_forcing), intent(inout) :: forces !< Forcing on the input domain + type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: Rho0 !< A reference density of seawater [R ~> kg m-3], + !! as used to calculate ustar. + logical, optional, intent(in) :: UpdateUstar !< A logical to determine if Ustar should be directly averaged + !! or updated from mean tau. + + real :: tx_mean, ty_mean, avg + real :: iRho0 + logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg, tau2ustar + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + iRho0 = US%L_to_Z / Rho0 + + tau2ustar = .false. + if (present(UpdateUstar)) tau2ustar = UpdateUstar + + call get_mech_forcing_groups(forces, do_stress, do_ustar, do_shelf, & + do_press, do_iceberg) + + if (do_stress) then + tx_mean = global_area_mean_u(forces%taux, G) + do j=js,je ; do i=isB,ieB + if (G%mask2dCu(I,j) > 0.) forces%taux(I,j) = tx_mean + enddo ; enddo + ty_mean = global_area_mean_v(forces%tauy, G) + do j=jsB,jeB ; do i=is,ie + if (G%mask2dCv(i,J) > 0.) forces%tauy(i,J) = ty_mean + enddo ; enddo + if (tau2ustar) then + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.) forces%ustar(i,j) = sqrt(sqrt(tx_mean**2 + ty_mean**2)*iRho0) + enddo ; enddo + else + call homogenize_field_t(forces%ustar, G) + endif + else + if (do_ustar) then + call homogenize_field_t(forces%ustar, G) + endif + endif + + if (do_shelf) then + call homogenize_field_u(forces%rigidity_ice_u, G) + call homogenize_field_v(forces%rigidity_ice_v, G) + call homogenize_field_u(forces%frac_shelf_u, G) + call homogenize_field_v(forces%frac_shelf_v, G) + endif + + if (do_press) then + ! NOTE: p_surf_SSH either points to p_surf or p_surf_full + call homogenize_field_t(forces%p_surf, G) + call homogenize_field_t(forces%p_surf_full, G) + call homogenize_field_t(forces%net_mass_src, G) + endif + + if (do_iceberg) then + call homogenize_field_t(forces%area_berg, G) + call homogenize_field_t(forces%mass_berg, G) + endif + +end subroutine homogenize_mech_forcing + +!< Homogenize the fluxes +subroutine homogenize_forcing(fluxes, G) + type(forcing), intent(inout) :: fluxes !< Input forcing struct + type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing + + real :: avg + logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & + do_iceberg, do_heat_added, do_buoy + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + call get_forcing_groups(fluxes, do_water, do_heat, do_ustar, do_press, & + do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) + + if (do_ustar) then + call homogenize_field_t(fluxes%ustar, G) + call homogenize_field_t(fluxes%ustar_gustless, G) + endif + + if (do_water) then + call homogenize_field_t(fluxes%evap, G) + call homogenize_field_t(fluxes%lprec, G) + call homogenize_field_t(fluxes%lprec, G) + call homogenize_field_t(fluxes%fprec, G) + call homogenize_field_t(fluxes%vprec, G) + call homogenize_field_t(fluxes%lrunoff, G) + call homogenize_field_t(fluxes%frunoff, G) + call homogenize_field_t(fluxes%seaice_melt, G) + call homogenize_field_t(fluxes%netMassOut, G) + call homogenize_field_t(fluxes%netMassIn, G) + !This was removed and I don't think replaced. Not needed? + !call homogenize_field_t(fluxes%netSalt, G) + endif + + if (do_heat) then + call homogenize_field_t(fluxes%seaice_melt_heat, G) + call homogenize_field_t(fluxes%sw, G) + call homogenize_field_t(fluxes%lw, G) + call homogenize_field_t(fluxes%latent, G) + call homogenize_field_t(fluxes%sens, G) + call homogenize_field_t(fluxes%latent_evap_diag, G) + call homogenize_field_t(fluxes%latent_fprec_diag, G) + call homogenize_field_t(fluxes%latent_frunoff_diag, G) + endif + + if (do_salt) call homogenize_field_t(fluxes%salt_flux, G) + + if (do_heat .and. do_water) then + call homogenize_field_t(fluxes%heat_content_cond, G) + call homogenize_field_t(fluxes%heat_content_icemelt, G) + call homogenize_field_t(fluxes%heat_content_lprec, G) + call homogenize_field_t(fluxes%heat_content_fprec, G) + call homogenize_field_t(fluxes%heat_content_vprec, G) + call homogenize_field_t(fluxes%heat_content_lrunoff, G) + call homogenize_field_t(fluxes%heat_content_frunoff, G) + call homogenize_field_t(fluxes%heat_content_massout, G) + call homogenize_field_t(fluxes%heat_content_massin, G) + endif + + if (do_press) call homogenize_field_t(fluxes%p_surf, G) + + if (do_shelf) then + call homogenize_field_t(fluxes%frac_shelf_h, G) + call homogenize_field_t(fluxes%ustar_shelf, G) + call homogenize_field_t(fluxes%iceshelf_melt, G) + endif + + if (do_iceberg) then + call homogenize_field_t(fluxes%ustar_berg, G) + call homogenize_field_t(fluxes%area_berg, G) + endif + + if (do_heat_added) then + call homogenize_field_t(fluxes%heat_added, G) + endif + + ! The following fields are handled by drivers rather than control flags. + if (associated(fluxes%sw_vis_dir)) & + call homogenize_field_t(fluxes%sw_vis_dir, G) + + if (associated(fluxes%sw_vis_dif)) & + call homogenize_field_t(fluxes%sw_vis_dif, G) + + if (associated(fluxes%sw_nir_dir)) & + call homogenize_field_t(fluxes%sw_nir_dir, G) + + if (associated(fluxes%sw_nir_dif)) & + call homogenize_field_t(fluxes%sw_nir_dif, G) + + if (associated(fluxes%salt_flux_in)) & + call homogenize_field_t(fluxes%salt_flux_in, G) + + if (associated(fluxes%salt_flux_added)) & + call homogenize_field_t(fluxes%salt_flux_added, G) + + if (associated(fluxes%p_surf_full)) & + call homogenize_field_t(fluxes%p_surf_full, G) + + if (associated(fluxes%buoy)) & + call homogenize_field_t(fluxes%buoy, G) + + if (associated(fluxes%TKE_tidal)) & + call homogenize_field_t(fluxes%TKE_tidal, G) + + if (associated(fluxes%ustar_tidal)) & + call homogenize_field_t(fluxes%ustar_tidal, G) + + ! TODO: tracer flux homogenization + ! Having a warning causes a lot of errors (each time step). + !if (coupler_type_initialized(fluxes%tr_fluxes)) & + ! call MOM_error(WARNING, "Homogenization of tracer BC fluxes not yet implemented.") + +end subroutine homogenize_forcing + +subroutine homogenize_field_t(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJ_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + avg = global_area_mean(var, G) + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.) var(i,j) = avg + enddo ; enddo + +end subroutine homogenize_field_t + +subroutine homogenize_field_v(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, is, ie, jsB, jeB + is = G%isc ; ie = G%iec ; jsB = G%jscB ; jeB = G%jecB + + avg = global_area_mean_v(var, G) + do J=jsB,jeB ; do i=is,ie + if (G%mask2dCv(i,J) > 0.) var(i,J) = avg + enddo ; enddo + +end subroutine homogenize_field_v + +subroutine homogenize_field_u(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, isB, ieB, js, je + isB = G%iscB ; ieB = G%iecB ; js = G%jsc ; je = G%jec + + avg = global_area_mean_u(var, G) + do j=js,je ; do I=isB,ieB + if (G%mask2dCu(I,j) > 0.) var(I,j) = avg + enddo ; enddo + +end subroutine homogenize_field_u + !> \namespace mom_forcing_type !! !! \section section_fluxes Boundary fluxes diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index ffbdc5f810..7969ee11f8 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -17,7 +17,7 @@ module MOM_spatial_means #include public :: global_i_mean, global_j_mean -public :: global_area_mean, global_layer_mean +public :: global_area_mean, global_area_mean_u, global_area_mean_v, global_layer_mean public :: global_area_integral public :: global_volume_mean, global_mass_integral public :: adjust_area_mean_to_zero @@ -47,6 +47,50 @@ function global_area_mean(var, G, scale) end function global_area_mean +!> Return the global area mean of a variable. This uses reproducing sums. +function global_area_mean_v(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(in) :: var !< The variable to average + + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: global_area_mean_v + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + tmpForSumming(:,:) = 0. + do J=js,je ; do i=is,ie + tmpForSumming(i,j) = G%areaT(i,j) * (var(i,J) * G%mask2dCv(i,J) + & + var(i,J-1) * G%mask2dCv(i,J-1)) & + / max(1.e-20,G%mask2dCv(i,J)+G%mask2dCv(i,J-1)) + enddo ; enddo + global_area_mean_v = reproducing_sum(tmpForSumming) * G%IareaT_global + +end function global_area_mean_v + +!> Return the global area mean of a variable on U grid. This uses reproducing sums. +function global_area_mean_u(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZIB_(G), SZJ_(G)), intent(in) :: var !< The variable to average + + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: global_area_mean_u + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + tmpForSumming(:,:) = 0. + do j=js,je ; do i=is,ie + tmpForSumming(i,j) = G%areaT(i,j) * (var(I,j) * G%mask2dCu(I,j) + & + var(I-1,j) * G%mask2dCu(I-1,j)) & + / max(1.e-20,G%mask2dCu(I,j)+G%mask2dCu(I-1,j)) + enddo ; enddo + global_area_mean_u = reproducing_sum(tmpForSumming) * G%IareaT_global + +end function global_area_mean_u + !> Return the global area integral of a variable, by default using the masked area from the !! grid, but an alternate could be used instead. This uses reproducing sums. function global_area_integral(var, G, scale, area) From df46be459304cc3571d0a2c7cc5727fed41ff076 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Thu, 6 Jan 2022 18:28:22 -0500 Subject: [PATCH 129/138] Hydrostatic initialization in ice cavities (#41) * Hydrostatic initialization in ice cavities - Iteratively solve for the initial ice shelf displacement in cavities by calculating the pressure at the current displacement depth using the unperturbed profile. - This change should obsolete TRIM_IC_FOR_PSURF and DEPRESS_INITIAL_SURFACE for ice shelf applications and should work for arbitrary equations of state. - Existing implementations (e.g. ISOMIP) should turn off the above options in order to exercise this feature. - This code change should not impact non ice-shelf configurations or those with either of the above two options. * Addresses a number of issues identified in code review. * add appropriate intent to ice_shelf_query * fix unit scaling comments Co-authored-by: Marshall Ward --- src/core/MOM.F90 | 26 ++- src/ice_shelf/MOM_ice_shelf.F90 | 14 +- .../MOM_state_initialization.F90 | 163 +++++++++++++++--- 3 files changed, 164 insertions(+), 39 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b16681156b..7a15d58bb1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -283,7 +283,8 @@ module MOM type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. real, dimension(:,:), pointer :: frac_shelf_h => NULL() !< fraction of total area occupied - !! by ice shelf [nondim] + !! by ice shelf [nondim] + real, dimension(:,:), pointer :: mass_shelf => NULL() !< Mass of ice shelf [R Z ~> kg m-2] real, dimension(:,:,:), pointer :: & h_pre_dyn => NULL(), & !< The thickness before the transports [H ~> m or kg m-2]. T_pre_dyn => NULL(), & !< Temperature before the transports [degC]. @@ -1748,9 +1749,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real, allocatable :: v_in(:,:,:) ! Initial meridional velocities [L T-1 ~> m s-1] real, allocatable :: h_in(:,:,:) ! Initial layer thicknesses [H ~> m or kg m-2] real, allocatable, target :: frac_shelf_in(:,:) ! Initial fraction of the total cell area occupied - ! by an ice shelf [nondim] + ! by an ice shelf [nondim] + real, allocatable, target :: mass_shelf_in(:,:) ! Initial mass of ice shelf contained within a grid cell + ! [R Z ~> kg m-2] real, allocatable, target :: T_in(:,:,:) ! Initial temperatures [degC] real, allocatable, target :: S_in(:,:,:) ! Initial salinities [ppt] + type(ocean_OBC_type), pointer :: OBC_in => NULL() type(sponge_CS), pointer :: sponge_in_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_in_CSp => NULL() @@ -2523,14 +2527,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr) allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) + allocate(mass_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) - call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) + allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0) + call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf) ! MOM_initialize_state is using the unrotated metric call rotate_array(CS%frac_shelf_h, -turns, frac_shelf_in) + call rotate_array(CS%mass_shelf, -turns, mass_shelf_in) call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & sponge_in_CSp, ALE_sponge_in_CSp, oda_incupd_in_CSp, OBC_in, Time_in, & - frac_shelf_h=frac_shelf_in) + frac_shelf_h=frac_shelf_in, mass_shelf = mass_shelf_in) else call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2574,16 +2581,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & deallocate(S_in) endif if (use_ice_shelf) & - deallocate(frac_shelf_in) + deallocate(frac_shelf_in,mass_shelf_in) else if (use_ice_shelf) then call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) - call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) + allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0) + call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp,CS%oda_incupd_CSp, CS%OBC, Time_in, & - frac_shelf_h=CS%frac_shelf_h) + frac_shelf_h=CS%frac_shelf_h, mass_shelf=CS%mass_shelf) else call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2598,8 +2606,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif - if (use_ice_shelf .and. CS%debug) & + if (use_ice_shelf .and. CS%debug) then call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, haloshift=0) + call hchksum(CS%mass_shelf, "MOM:mass_shelf", G%HI, haloshift=0,scale=US%RZ_to_kg_m2) + endif call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 9dd3791211..13af5a936a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -2032,11 +2032,12 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time) end subroutine update_shelf_mass !> Save the ice shelf restart file -subroutine ice_shelf_query(CS, G, frac_shelf_h) +subroutine ice_shelf_query(CS, G, frac_shelf_h, mass_shelf) type(ice_shelf_CS), pointer :: CS !< ice shelf control structure type(ocean_grid_type), intent(in) :: G !< A pointer to an ocean grid control structure. - real, optional, dimension(SZI_(G),SZJ_(G)) :: frac_shelf_h !< - !< Ice shelf area fraction [nodim]. + real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: frac_shelf_h !< Ice shelf area fraction [nodim]. + real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: mass_shelf ! kg m-2] + integer :: i, j @@ -2047,6 +2048,13 @@ subroutine ice_shelf_query(CS, G, frac_shelf_h) enddo ; enddo endif + if (present(mass_shelf)) then + do j=G%jsd,G%jed ; do i=G%isd,G%ied + mass_shelf(i,j) = 0.0 + if (G%areaT(i,j)>0.) mass_shelf(i,j) = CS%ISS%mass_shelf(i,j) + enddo ; enddo + endif + end subroutine ice_shelf_query !> Save the ice shelf restart file diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0d5342d9be..f95192f5f8 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -117,7 +117,7 @@ module MOM_state_initialization !! conditions or by reading them from a restart (or saves) file. subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & restart_CS, ALE_CSp, tracer_Reg, sponge_CSp, & - ALE_sponge_CSp, oda_incupd_CSp, OBC, Time_in, frac_shelf_h) + ALE_sponge_CSp, oda_incupd_CSp, OBC, Time_in, frac_shelf_h, mass_shelf) 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 @@ -147,6 +147,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & 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]. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: mass_shelf !< The mass per unit area of the overlying + !! ice shelf [ R Z ~> kg m-2 ] ! Local variables real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m] character(len=200) :: filename ! The name of an input file. @@ -158,6 +161,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & real :: vel_rescale ! A rescaling factor for velocities from the representation in ! a restart file to the internal representation in this run. real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. + logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -404,6 +408,23 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (use_temperature .and. use_OBC) & call fill_temp_salt_segments(G, GV, OBC, tv) + ! Calculate the initial surface displacement under ice shelf + + call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & + "If true, depress the initial surface to avoid huge "//& + "tsunamis when a large surface pressure is applied.", & + default=.false., do_not_log=just_read) + call get_param(PF, mdl, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & + "If true, cuts way the top of the column for initial conditions "//& + "at the depth where the hydrostatic pressure matches the imposed "//& + "surface pressure which is read from file.", default=.false., & + do_not_log=just_read) + + if (new_sim) then + if (use_ice_shelf .and. present(mass_shelf) .and. .not. (trim_ic_for_p_surf .or. depress_sfc)) & + call calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + endif + ! The thicknesses in halo points might be needed to initialize the velocities. if (new_sim) call pass_var(h, G%Domain) @@ -458,15 +479,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call convert_thickness(h, G, GV, US, tv) ! Remove the mass that would be displaced by an ice shelf or inverse barometer. - call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & - "If true, depress the initial surface to avoid huge "//& - "tsunamis when a large surface pressure is applied.", & - default=.false., do_not_log=just_read) - call get_param(PF, mdl, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & - "If true, cuts way the top of the column for initial conditions "//& - "at the depth where the hydrostatic pressure matches the imposed "//& - "surface pressure which is read from file.", default=.false., & - do_not_log=just_read) if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & @@ -1035,7 +1047,7 @@ subroutine convert_thickness(h, G, GV, US, tv) end subroutine convert_thickness !> Depress the sea-surface based on an initial condition file -subroutine depress_surface(h, G, GV, US, param_file, tv, just_read) +subroutine depress_surface(h, G, GV, US, param_file, tv, just_read, z_top_shelf) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1045,6 +1057,8 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing h. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: z_top_shelf !< Top interface position under ice shelf [Z ~> m] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & eta_sfc ! The free surface height that the model should use [Z ~> m]. @@ -1057,30 +1071,40 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read) character(len=200) :: inputdir, eta_srf_file ! Strings for file/path character(len=200) :: filename, eta_srf_var ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz + logical :: use_z_shelf is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! Read the surface height (or pressure) from a file. + use_z_shelf = present(z_top_shelf) - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& - "The initial condition file for the surface height.", & - fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & - "The initial condition variable for the surface height.",& - default="SSH", do_not_log=just_read) - filename = trim(inputdir)//trim(eta_srf_file) - if (.not.just_read) & - call log_param(param_file, mdl, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & - "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into units of m", & - units="variable", default=1.0, scale=US%m_to_Z, do_not_log=just_read) + if (.not. use_z_shelf) then + ! Read the surface height (or pressure) from a file. - if (just_read) return ! All run-time parameters have been read, so return. + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& + "The initial condition file for the surface height.", & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & + "The initial condition variable for the surface height.",& + default="SSH", do_not_log=just_read) + filename = trim(inputdir)//trim(eta_srf_file) + if (.not.just_read) & + call log_param(param_file, mdl, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) + + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & + "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into units of m", & + units="variable", default=1.0, scale=US%m_to_Z, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) + call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) + else + do j=js,je ; do i=is,ie + eta_sfc(i,j) = z_top_shelf(i,j) + enddo; enddo + endif ! Convert thicknesses to interface heights. call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) @@ -1201,6 +1225,88 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) end subroutine trim_for_ice +!> Calculate the hydrostatic equilibrium position of the surface under an ice shelf +subroutine calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + type(param_file_type), intent(in) :: PF !< Parameter file 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)), & + intent(in) :: mass_shelf !< Ice shelf mass [R Z ~> kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + + real :: z_top_shelf(SZI_(G),SZJ_(G)) ! The depth of the top interface under ice shelves [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & + eta ! The free surface height that the model should use [Z ~> m]. + ! temporary arrays + real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice + real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2 ] + real, dimension(SZK_(GV)) :: h_tmp ! temporary storage for thicknesses [H ~> m] + real, dimension(SZK_(GV)) :: p_ref ! pressure for density [R Z ~> kg m-2] + real, dimension(SZK_(GV)+1) :: ei_tmp, ei_orig ! temporary storage for interface positions [Z ~> m] + real :: z_top, z_col, mass_disp, residual, tol + integer :: is, ie, js, je, k, nz, i, j, max_iter, iter + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + + tol = 0.001 ! The initialization tolerance for ice shelf initialization (m) + call get_param(PF, mdl, "ICE_SHELF_INITIALIZATION_Z_TOLERANCE", tol, & + "A initialization tolerance for the calculation of the static "// & + "ice shelf displacement (m) using initial temperature and salinity profile.",& + default=tol, units="m", scale=US%m_to_Z) + max_iter = 1e3 + call MOM_mesg("Started calculating initial interface position under ice shelf ") + ! Convert thicknesses to interface heights. + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) + do j = js, je ; do i = is, ie + iter = 1 + z_top_shelf(i,j) = 0.0 + p_ref(:) = tv%p_ref + if (G%mask2dT(i,j) .gt. 0. .and. mass_shelf(i,j) .gt. 0.) then + call calculate_density(tv%T(i,j,:), tv%S(i,j,:), P_Ref, rho_col, tv%eqn_of_state) + z_top = min(max(-1.0*mass_shelf(i,j)/rho_col(1),-G%bathyT(i,j)),0.) + h_tmp = 0.0 + z_col = 0.0 + ei_tmp(1:nz+1)=eta(i,j,1:nz+1) + ei_orig(1:nz+1)=eta(i,j,1:nz+1) + do k=1,nz+1 + if (ei_tmp(k) Adjust the layer thicknesses by removing the top of the water column above the !! depth where the hydrostatic pressure matches p_surf @@ -2597,6 +2703,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just old_remap=remap_old_alg, answers_2018=answers_2018 ) call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & old_remap=remap_old_alg, answers_2018=answers_2018 ) + deallocate( h1 ) deallocate( tmpT1dIn ) deallocate( tmpS1dIn ) From f7a2254f3652727217d578f3aac4966a0d4da864 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 8 Jan 2022 06:12:14 -0500 Subject: [PATCH 130/138] Rewrite horizontal regridding to use netCDF wrapper functions (#48) * Refresh attempt to get rid of NetCDF calls * Fix comments * Set netCDF attrs in MOM_horizontal_regridding This patch sets the following netCDF attributes in the function `horiz_interp_and_extrap_tracer_record` via `read_attribute`. * `missing_value` (as `_FillValue`) * `scale_factor` * `add_offset` This resolves some issues related to uninitialized values. * read_variable_2d in horizontal remapping This patch extends the `read_variable` interface to include 2d array support, in order to facilitate domainless I/O via netCDF calls. This is far from the best implementation (e.g. read_variable_2d introduces another `broadcast` alongside the original one in the horizontal regridding) but it addresses the immediate issues with `MOM_read_data()`. * set default scale factor to 1 * add missing start/count arguments * Update MOM_io.F90 * Manage optional args in read_variable_2d This patch modifies read_variable_2d so that the size() tests of the optional arguments are applied before the call to nf90_get_var. The tests are also wrapped inside present() flags to avoid checking unassigned variables. Thanks to Robert Hallberg for the suggestions. Co-authored-by: Matthew Harrison --- src/framework/MOM_horizontal_regridding.F90 | 112 +++++--------- src/framework/MOM_io.F90 | 163 +++++++++++++++++++- 2 files changed, 204 insertions(+), 71 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 0f16a5b301..de511688a9 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -16,9 +16,8 @@ module MOM_horizontal_regridding use MOM_interpolate, only : build_horiz_interp_weights, run_horiz_interp, horiz_interp_type use MOM_interp_infra, only : axistype, get_external_field_info, get_axis_data use MOM_time_manager, only : time_type - -use netcdf, only : NF90_OPEN, NF90_NOWRITE, NF90_GET_ATT, NF90_GET_VAR -use netcdf, only : NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, NF90_INQUIRE_DIMENSION +use MOM_io, only : axis_info, get_axis_info, get_var_axes_info, MOM_read_data +use MOM_io, only : read_attribute, read_variable implicit none ; private @@ -304,10 +303,12 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real :: max_lat, min_lat, pole, max_depth, npole real :: roundoff ! The magnitude of roundoff, usually ~2e-16. real :: add_offset, scale_factor + logical :: found_attr logical :: add_np logical :: is_ongrid character(len=8) :: laynum type(horiz_interp_type) :: Interp + type(axis_info), dimension(4) :: axes_info ! Axis information used for regridding integer :: is, ie, js, je ! compute domain indices integer :: isc, iec, jsc, jec ! global compute domain indices integer :: isg, ieg, jsg, jeg ! global extent @@ -334,6 +335,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, is_ongrid = .false. if (present(ongrid)) is_ongrid = ongrid + if (allocated(tr_z)) deallocate(tr_z) + if (allocated(mask_z)) deallocate(mask_z) + PI_180 = atan(1.0)/45. ! Open NetCDF file and if present, extract data and spatial coordinate information @@ -341,64 +345,23 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call cpu_clock_begin(id_clock_read) - rcode = NF90_OPEN(filename, NF90_NOWRITE, ncid) - if (rcode /= 0) call MOM_error(FATAL,"error opening file "//trim(filename)//& - " in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, varnam, varid) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(varnam)//& - " in file "//trim(filename)//" in hinterp_extrap") - - rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims) - if (rcode /= 0) call MOM_error(FATAL, "Error inquiring about the dimensions of "//trim(varnam)//& - " in file "//trim(filename)//" in hinterp_extrap") - if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(varnam)//" in file "//trim(filename)// & - " has too few dimensions to be read as a 3-d array.") - - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& - " in file "//trim(filename)//" in hinterp_extrap") - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& - " in file "//trim(filename)//" in hinterp_extrap") - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& - " in file "//trim(filename)//" in hinterp_extrap") - - missing_value=0.0 - rcode = NF90_GET_ATT(ncid, varid, "_FillValue", missing_value) - if (rcode /= 0) call MOM_error(FATAL,"error finding missing value for "//trim(varnam)//& - " in file "// trim(filename)//" in hinterp_extrap") - - rcode = NF90_GET_ATT(ncid, varid, "add_offset", add_offset) - if (rcode /= 0) add_offset = 0.0 - - rcode = NF90_GET_ATT(ncid, varid, "scale_factor", scale_factor) - if (rcode /= 0) scale_factor = 1.0 + call get_var_axes_info(trim(filename), trim(varnam), axes_info) + + if (allocated(z_in)) deallocate(z_in) + if (allocated(z_edges_in)) deallocate(z_edges_in) + if (allocated(tr_z)) deallocate(tr_z) + if (allocated(mask_z)) deallocate(mask_z) + + call get_axis_info(axes_info(1),ax_size=id) + call get_axis_info(axes_info(2),ax_size=jd) + call get_axis_info(axes_info(3),ax_size=kd) 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 - 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 - 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 - 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") + call get_axis_info(axes_info(1),ax_data=lon_in) + call get_axis_info(axes_info(2),ax_data=lat_in) + call get_axis_info(axes_info(3),ax_data=z_in) call cpu_clock_end(id_clock_read) @@ -422,6 +385,21 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, endif ! construct level cell boundaries as the mid-point between adjacent centers + ! Set the I/O attributes + call read_attribute(trim(filename), "_FillValue", missing_value, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) call MOM_error(FATAL, & + "error finding missing value for " // trim(varnam) // & + " in file " // trim(filename) // " in hinterp_extrap") + + call read_attribute(trim(filename), "scale_factor", scale_factor, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) scale_factor = 1. + + call read_attribute(trim(filename), "add_offset", add_offset, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) add_offset = 0. + z_edges_in(1) = 0.0 do K=2,kd z_edges_in(K) = 0.5*(z_in(k-1)+z_in(k)) @@ -458,12 +436,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, 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 - rcode = NF90_GET_VAR(ncid,varid, tr_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"horiz_interp_and_extrap_tracer_record: "//& - "error reading level "//trim(laynum)//" of variable "//& - trim(varnam)//" in file "// trim(filename)) - + count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1; start(4) = 1; count(4) = 1 + call MOM_read_data(trim(filename), trim(varnam), tr_in, G%Domain, timelevel=1) do j=js,je do i=is,ie if (abs(tr_in(i,j)-missing_value) > abs(roundoff*missing_value)) then @@ -474,15 +448,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, endif enddo enddo - else + start(:) = 1 ; start(3) = k + count(:) = 1 ; count(1) = id ; count(2) = jd + call read_variable(trim(filename), trim(varnam), tr_in, start=start, nread=count) if (is_root_pe()) then - start = 1 ; start(3) = k ; count(:) = 1 ; count(1) = id ; count(2) = jd - rcode = NF90_GET_VAR(ncid,varid, tr_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"horiz_interp_and_extrap_tracer_record: "//& - "error reading level "//trim(laynum)//" of variable "//& - trim(varnam)//" in file "// trim(filename)) - if (add_np) then pole = 0.0 ; npole = 0.0 do i=1,id @@ -603,6 +573,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, enddo ! kd + deallocate(lon_in, lat_in) + end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 563f9f9f8a..2b8fb210d5 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -51,6 +51,8 @@ module MOM_io public :: slasher, write_field, write_version_number public :: io_infra_init, io_infra_end public :: stdout_if_root +public :: get_var_axes_info +public :: get_axis_info ! This is used to set up information descibing non-domain-decomposed axes. public :: axis_info, set_axis_info, delete_axis_info ! This is used to set up global file attributes @@ -98,6 +100,7 @@ module MOM_io interface read_variable module procedure read_variable_0d, read_variable_0d_int module procedure read_variable_1d, read_variable_1d_int + module procedure read_variable_2d end interface read_variable !> Read a global or variable attribute from a named netCDF file using netCDF calls @@ -887,6 +890,65 @@ subroutine read_variable_1d_int(filename, varname, var, ncid_in) call broadcast(var, size(var), blocking=.true.) end subroutine read_variable_1d_int +!> Read a 2d array from a netCDF input file and save to a variable. +!! +!! Start and nread ranks may exceed var, but must match the rank of the +!! variable in the netCDF file. This allows for reading slices of larger +!! arrays. +!! +!! I/O occurs only on the root PE, and data is broadcast to other ranks. +!! Due to potentially large memory communication and storage, this subroutine +!! should only be used when domain-decomposition is unavaialable. +subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) + character(len=*), intent(in) :: filename !< Name of file to be read + character(len=*), intent(in) :: varname !< Name of variable to be read + real, intent(out) :: var(:,:) !< Output array of variable + integer, optional, intent(in) :: start(:) !< Starting index on each axis. + integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis + integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. + !! If absent, the file is opened and closed within this routine. + + integer :: ncid, varid, ndims, rc + character(len=*), parameter :: hdr = "read_variable_2d" + character(len=128) :: msg + logical :: size_mismatch + + if (is_root_pe()) then + if (present(ncid_in)) then + ncid = ncid_in + else + call open_file_to_Read(filename, ncid) + endif + + call get_varid(varname, ncid, filename, varid, match_case=.false.) + if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//& + " in "//trim(filename)) + ! Verify that start(:) and nread(:) ranks match variable's dimension count + rc = nf90_inquire_variable(ncid, varid, ndims=ndims) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + " Difficulties reading "//trim(varname)//" from "//trim(filename)) + + size_mismatch = .false. + if (present(start)) size_mismatch = size_mismatch .or. size(start) /= ndims + if (present(nread)) size_mismatch = size_mismatch .or. size(nread) /= ndims + + if (size_mismatch) then + write (msg, '("'// hdr //': size(start) ", i0, " and/or size(nread) ", & + i0, " do not match ndims ", i0)') size(start), size(nread), ndims + call MOM_error(FATAL, trim(msg)) + endif + ! NOTE: We could check additional information here (type, size, ...) + + rc = nf90_get_var(ncid, varid, var, start, nread) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + " Difficulties reading "//trim(varname)//" from "//trim(filename)) + + if (.not.present(ncid_in)) call close_file_to_read(ncid, filename) + endif + + call broadcast(var, size(var), blocking=.true.) +end subroutine read_variable_2d + !> Read a character-string global or variable attribute subroutine read_attribute_str(filename, attname, att_val, varname, found, all_read, ncid_in) character(len=*), intent(in) :: filename !< Name of the file to read @@ -1542,6 +1604,32 @@ subroutine delete_axis_info(axes) enddo end subroutine delete_axis_info + +!> Retrieve the information from an axis_info type. +subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) + type(axis_info), intent(in) :: axis !< An axis type + character(len=*), intent(out), optional :: name !< The axis name. + character(len=*), intent(out), optional :: longname !< The axis longname. + character(len=*), intent(out), optional :: units !< The axis units. + character(len=*), intent(out), optional :: cartesian !< The cartesian attribute + !! of the axis [X,Y,Z,T]. + integer, intent(out), optional :: ax_size !< The size of the axis. + real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. + + if (present(ax_data)) then + if (allocated(ax_data)) deallocate(ax_data) + allocate(ax_data(axis%ax_size)) + ax_data(:)=axis%ax_data + endif + + if (present(name)) name=axis%name + if (present(longname)) longname=axis%longname + if (present(units)) units=axis%units + if (present(cartesian)) cartesian=axis%cartesian + if (present(ax_size)) ax_size=axis%ax_size + +end subroutine get_axis_info + !> Store information that can be used to create an attribute in a subsequent call to create_file. subroutine set_attribute_info(attribute, name, str_value) type(attribute_info), intent(inout) :: attribute !< A type with information about a named attribute @@ -2233,7 +2321,80 @@ subroutine MOM_io_init(param_file) call log_version(param_file, mdl, version) end subroutine MOM_io_init - +!> Returns the dimension variable information for a netCDF variable +subroutine get_var_axes_info(filename, fieldname, axes_info) + character(len=*), intent(in) :: filename !< A filename from which to read + character(len=*), intent(in) :: fieldname !< The name of the field to read + type(axis_info), dimension(4), intent(inout) :: axes_info !< A returned array of field axis information + + !! local variables + integer :: rcode + logical :: success + integer :: ncid, varid, ndims + integer :: id, jd, kd + integer, dimension(4) :: dims, dim_id + real :: missing_value + character(len=128) :: dim_name(4) + integer, dimension(1) :: start, count + !! cartesian axis data + real, allocatable, dimension(:) :: x + real, allocatable, dimension(:) :: y + real, allocatable, dimension(:) :: z + + + call open_file_to_read(filename, ncid, success=success) + + rcode = NF90_INQ_VARID(ncid, trim(fieldname), varid) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(fieldname)//& + " in file "//trim(filename)//" in hinterp_extrap") + + rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims) + if (rcode /= 0) call MOM_error(FATAL, "Error inquiring about the dimensions of "//trim(fieldname)//& + " in file "//trim(filename)//" in hinterp_extrap") + if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(fieldname)//" in file "//trim(filename)// & + " has too few dimensions to be read as a 3-d array.") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& + " in file "//trim(filename)//" in hinterp_extrap") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& + " in file "//trim(filename)//" in hinterp_extrap") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& + " in file "//trim(filename)//" in hinterp_extrap") + allocate(x(id), y(jd), z(kd)) + + start = 1 ; count = 1 ; count(1) = id + rcode = NF90_GET_VAR(ncid, dim_id(1), x, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & + trim(fieldname)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") + start = 1 ; count = 1 ; count(1) = jd + rcode = NF90_GET_VAR(ncid, dim_id(2), y, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & + trim(fieldname)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") + start = 1 ; count = 1 ; count(1) = kd + rcode = NF90_GET_VAR(ncid, dim_id(3), z, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & + trim(fieldname//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") + + call set_axis_info(axes_info(1), name=trim(dim_name(1)), ax_size=id, ax_data=x,cartesian='X') + call set_axis_info(axes_info(2), name=trim(dim_name(2)), ax_size=jd, ax_data=y,cartesian='Y') + call set_axis_info(axes_info(3), name=trim(dim_name(3)), ax_size=kd, ax_data=z,cartesian='Z') + + call close_file_to_read(ncid, filename) + + deallocate(x,y,z) + +end subroutine get_var_axes_info !> \namespace mom_io !! !! This file contains a number of subroutines that manipulate From d838ccd800676990aa5718043200336388f51d82 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Jan 2022 09:13:24 -0500 Subject: [PATCH 131/138] Clean up non-standard syntax and whitespace Eliminated a number of instances of non-standard syntax from that described in https://github.com/NOAA-GFDL/MOM6/wiki/Code-style-guide. The changes include enforcing the MOM6-standard 2-point indentation convention, replacing 'if(A)' with 'if (A)', and changing logical comparison syntax like '.gt.' to '>' or '.eq.' to '=='. An old commented out block of code for debugging (detected by its use of non-standard syntax) was also eliminated. All answers and output are bitwise identical. --- src/ALE/MOM_ALE.F90 | 4 +- src/core/MOM.F90 | 12 +-- src/core/MOM_continuity_PPM.F90 | 2 +- src/core/MOM_dynamics_split_RK2.F90 | 18 ++-- src/core/MOM_dynamics_unsplit.F90 | 23 +++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 20 ++-- src/core/MOM_open_boundary.F90 | 8 +- src/core/MOM_variables.F90 | 8 +- src/framework/MOM_checksums.F90 | 20 ++-- src/framework/MOM_document.F90 | 18 ++-- src/framework/MOM_io.F90 | 16 +-- src/framework/MOM_random.F90 | 10 +- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 8 +- src/ocean_data_assim/MOM_oda_driver.F90 | 98 +++++++++---------- .../lateral/MOM_internal_tides.F90 | 4 +- .../lateral/MOM_tidal_forcing.F90 | 2 +- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 5 +- .../vertical/MOM_tidal_mixing.F90 | 27 ++--- src/tracer/MOM_lateral_boundary_diffusion.F90 | 14 +-- 20 files changed, 150 insertions(+), 169 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 9aa01738b6..41ee555c52 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -869,7 +869,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) endif if (associated(OBC)) then - if (OBC%segnum_u(I,j) .ne. 0) then + if (OBC%segnum_u(I,j) /= 0) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) @@ -902,7 +902,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) endif if (associated(OBC)) then - if (OBC%segnum_v(i,J) .ne. 0) then + if (OBC%segnum_v(i,J) /= 0) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 7a15d58bb1..c36c0545e1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1138,11 +1138,9 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT - if (CS%do_dynamics) then!run particles whether or not stepping is split - if (CS%use_particles) then - call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model - endif - endif + if (CS%use_particles .and. CS%do_dynamics) then ! Run particles whether or not stepping is split + call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model + endif if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then @@ -3721,8 +3719,8 @@ subroutine MOM_end(CS) endif if (CS%use_particles) then - call particles_end(CS%particles) - deallocate(CS%particles) + call particles_end(CS%particles) + deallocate(CS%particles) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 95de2fd923..e5bd2f9ae9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -1282,7 +1282,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac l_seg = OBC%segnum_v(i,J) do_I(I) = .false. - if(l_seg /= OBC_NONE) & + if (l_seg /= OBC_NONE) & do_I(i) = (OBC%segment(l_seg)%specified) if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 68b844562f..f22fb9a862 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1368,12 +1368,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_PFu = register_diag_field('ocean_model', 'h_PFu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Pressure Force Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_PFv = register_diag_field('ocean_model', 'h_PFv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Pressure Force Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_PFu_2d = register_diag_field('ocean_model', 'intz_PFu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Pressure Force Acceleration', & @@ -1398,12 +1398,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_CAu = register_diag_field('ocean_model', 'h_CAu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_CAv = register_diag_field('ocean_model', 'h_CAv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_CAu_2d = register_diag_field('ocean_model', 'intz_CAu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Coriolis and Advective Acceleration', & @@ -1448,12 +1448,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_u_BT_accel = register_diag_field('ocean_model', 'h_u_BT_accel', diag%axesCuL, Time, & 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_v_BT_accel = register_diag_field('ocean_model', 'h_v_BT_accel', diag%axesCvL, Time, & 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_u_BT_accel_2d = register_diag_field('ocean_model', 'intz_u_BT_accel_2d', diag%axesCu1, Time, & 'Depth-integral of Barotropic Anomaly Zonal Acceleration', & @@ -1472,7 +1472,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', & @@ -1481,7 +1481,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', & @@ -1490,7 +1490,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index fcc4c3d49b..9a58dddd0f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -239,8 +239,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -431,22 +429,23 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) call enable_averages(dt, Time_local, CS%diag) -! Calculate effective areas and post data + ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) endif if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) endif - ! h_av = (h + hp)/2 do k=1,nz do j=js-2,je+2 ; do i=is-2,ie+2 diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 694d88f2ea..ec4a1aa843 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -250,8 +250,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -452,17 +450,19 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) endif if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2c3f016005..41ba70f152 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -859,7 +859,7 @@ subroutine initialize_segment_data(G, OBC, PF) ! siz(3) is constituent for tidal variables call field_size(filename, 'constituent', siz, no_domain=.true.) ! expect third dimension to be number of constituents in MOM_input - if (siz(3) .ne. OBC%n_tide_constituents .and. OBC%add_tide_constituents) then + if (siz(3) /= OBC%n_tide_constituents .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Number of constituents in input data is not '//& 'the same as the number specified') endif @@ -897,7 +897,7 @@ subroutine initialize_segment_data(G, OBC, PF) ! Check if this is a tidal field. If so, the number ! of expected constituents must be 1. if ((index(segment%field(m)%name, 'phase') > 0) .or. (index(segment%field(m)%name, 'amp') > 0)) then - if (OBC%n_tide_constituents .gt. 1 .and. OBC%add_tide_constituents) then + if (OBC%n_tide_constituents > 1 .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Only one constituent is supported when specifying '//& 'tidal boundary conditions by value rather than file.') endif @@ -997,7 +997,7 @@ subroutine initialize_obc_tides(OBC, US, param_file) ! If the nodal correction is based on a different time, initialize that. ! Otherwise, it can use N from the time reference. if (OBC%add_nodal_terms) then - if (sum(nodal_ref_date) .ne. 0) then + if (sum(nodal_ref_date) /= 0) then ! A reference date was provided for the nodal correction nodal_time = set_date(nodal_ref_date(1), nodal_ref_date(2), nodal_ref_date(3)) call astro_longitudes_init(nodal_time, nodal_longitudes) @@ -3939,7 +3939,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif ! no dz for tidal variables if (segment%field(m)%nk_src > 1 .and.& - (index(segment%field(m)%name, 'phase') .le. 0 .and. index(segment%field(m)%name, 'amp') .le. 0)) then + (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then call time_interp_external(segment%field(m)%fid_dz,Time, tmp_buffer_in) if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index ba5001e427..a9bf6c3dcf 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -316,10 +316,10 @@ module MOM_variables !> pointers to grids modifying cell metric at porous barriers type, public :: porous_barrier_ptrs - real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] end type porous_barrier_ptrs diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index fffdb9bed8..d1a8102fc1 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -110,7 +110,7 @@ subroutine chksum0(scalar, mesg, scale, logunit) call chksum_error(FATAL, 'NaN detected: '//trim(mesg)) scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then rs = scaling * scalar @@ -147,7 +147,7 @@ subroutine zchksum(array, mesg, scale, logunit) endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -352,7 +352,7 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -618,7 +618,7 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -901,7 +901,7 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1079,7 +1079,7 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1246,7 +1246,7 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -1397,7 +1397,7 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1576,7 +1576,7 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1754,7 +1754,7 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index ff0934ac55..24f77a0eb2 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -672,22 +672,22 @@ function real_array_string(vals, sep) integer :: j, n, ns logical :: doWrite character(len=10) :: separator - n=1 ; doWrite=.true. ; real_array_string='' + n = 1 ; doWrite = .true. ; real_array_string = '' if (present(sep)) then - separator=sep ; ns=len(sep) + separator = sep ; ns = len(sep) else - separator=', ' ; ns=2 + separator = ', ' ; ns = 2 endif do j=1,size(vals) - doWrite=.true. - if (j0) then ! Write separator if a number has already been written + if (len(real_array_string) > 0) then ! Write separator if a number has already been written real_array_string = real_array_string // separator(1:ns) endif if (n>1) then diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 2b8fb210d5..2ea19df183 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -1617,16 +1617,16 @@ subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. if (present(ax_data)) then - if (allocated(ax_data)) deallocate(ax_data) - allocate(ax_data(axis%ax_size)) - ax_data(:)=axis%ax_data + if (allocated(ax_data)) deallocate(ax_data) + allocate(ax_data(axis%ax_size)) + ax_data(:) = axis%ax_data endif - if (present(name)) name=axis%name - if (present(longname)) longname=axis%longname - if (present(units)) units=axis%units - if (present(cartesian)) cartesian=axis%cartesian - if (present(ax_size)) ax_size=axis%ax_size + if (present(name)) name = axis%name + if (present(longname)) longname = axis%longname + if (present(units)) units = axis%units + if (present(cartesian)) cartesian = axis%cartesian + if (present(ax_size)) ax_size = axis%ax_size end subroutine get_axis_info diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 709fd27731..bef78a433a 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -223,9 +223,9 @@ function new_RandomNumberSequence(seed) result(twister) twister%state(0) = iand(seed, -1) do i = 1, blockSize - 1 ! ubound(twister%state) - twister%state(i) = 1812433253 * ieor(twister%state(i-1), & - ishft(twister%state(i-1), -30)) + i - twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines + twister%state(i) = 1812433253 * ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30)) + i + twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines end do twister%currentElement = blockSize end function new_RandomNumberSequence @@ -236,7 +236,7 @@ end function new_RandomNumberSequence integer function getRandomInt(twister) type(randomNumberSequence), intent(inout) :: twister !< The Mersenne Twister container - if(twister%currentElement >= blockSize) call nextState(twister) + if (twister%currentElement >= blockSize) call nextState(twister) getRandomInt = temper(twister%state(twister%currentElement)) twister%currentElement = twister%currentElement + 1 @@ -251,7 +251,7 @@ double precision function getRandomReal(twister) integer :: localInt localInt = getRandomInt(twister) - if(localInt < 0) then + if (localInt < 0) then getRandomReal = dble(localInt + 2.0d0**32)/(2.0d0**32 - 1.0d0) else getRandomReal = dble(localInt )/(2.0d0**32 - 1.0d0) diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 2a3066dfbd..ef4ad7b6d9 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -448,7 +448,7 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & type(diag_type), pointer :: diag => NULL() MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -537,7 +537,7 @@ integer function register_MOM_IS_static_field(module_name, field_name, axes, & type(diag_ctrl), pointer :: diag_cs !< A structure that is used to regulate diagnostic output MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -582,8 +582,8 @@ function i2s(a, n_in) character(len=15) :: i2s_temp integer :: i,n - n=size(a) - if(present(n_in)) n = n_in + n = size(a) + if (present(n_in)) n = n_in i2s = '' do i=1,n diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index d5259d760a..f183231c88 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -79,9 +79,9 @@ module MOM_oda_driver_mod !> A structure containing integer handles for bias adjustment of tracers type :: INC_CS - integer :: fldno = 0 !< The number of tracers - integer :: T_id !< The integer handle for the temperature file - integer :: S_id !< The integer handle for the salinity file + integer :: fldno = 0 !< The number of tracers + integer :: T_id !< The integer handle for the temperature file + integer :: S_id !< The integer handle for the salinity file end type INC_CS !> Control structure that contains a transpose of the ocean state across ensemble members. @@ -353,21 +353,21 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) if (CS%do_bias_adjustment) then - call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & - "The name of the file containing temperature and salinity "//& - "tendency adjustments", default='temp_salt_adjustment.nc') + call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & + "The name of the file containing temperature and salinity "//& + "tendency adjustments", default='temp_salt_adjustment.nc') - inc_file = trim(inputdir) // trim(bias_correction_file) - CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & + inc_file = trim(inputdir) // trim(bias_correction_file) + CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & + CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) - CS%INC_CS%fldno = 2 - if (CS%nk .ne. fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') - allocate(CS%tv_bc) ! storage for increment - allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) - allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) + CS%INC_CS%fldno = 2 + if (CS%nk /= fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') + allocate(CS%tv_bc) ! storage for increment + allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) endif call cpu_clock_end(id_clock_oda_init) @@ -455,7 +455,7 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) integer :: seconds_per_hour = 3600. ! return if not analysis time (retain pointers for h and tv) - if (Time < CS%Time .or. CS%assim_method .eq. NO_ASSIM) return + if (Time < CS%Time .or. CS%assim_method == NO_ASSIM) return !! switch to global pelist @@ -531,43 +531,43 @@ subroutine oda(Time, CS) end subroutine oda subroutine get_bias_correction_tracer(Time, CS) - type(time_type), intent(in) :: Time !< the current model time - type(ODA_CS), pointer :: CS !< ocean DA control structure - - integer :: i,j,k - real, allocatable, dimension(:,:,:) :: T_bias, S_bias - real, allocatable, dimension(:,:,:) :: mask_z - real, allocatable, dimension(:), target :: z_in, z_edges_in - real :: missing_value - integer,dimension(3) :: fld_sz - - call cpu_clock_begin(id_clock_bias_adjustment) - call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - - ! This should be replaced to use mask_z instead of the following lines - ! which are intended to zero land values using an arbitrary limit. - fld_sz=shape(T_bias) - do i=1,fld_sz(1) - do j=1,fld_sz(2) - do k=1,fld_sz(3) - if (T_bias(i,j,k) .gt. 1.0E-3) T_bias(i,j,k) = 0.0 - if (S_bias(i,j,k) .gt. 1.0E-3) S_bias(i,j,k) = 0.0 - enddo - enddo + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer :: CS !< ocean DA control structure + + integer :: i,j,k + real, allocatable, dimension(:,:,:) :: T_bias, S_bias + real, allocatable, dimension(:,:,:) :: mask_z + real, allocatable, dimension(:), target :: z_in, z_edges_in + real :: missing_value + integer,dimension(3) :: fld_sz + + call cpu_clock_begin(id_clock_bias_adjustment) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + + ! This should be replaced to use mask_z instead of the following lines + ! which are intended to zero land values using an arbitrary limit. + fld_sz=shape(T_bias) + do i=1,fld_sz(1) + do j=1,fld_sz(2) + do k=1,fld_sz(3) + if (T_bias(i,j,k) > 1.0E-3) T_bias(i,j,k) = 0.0 + if (S_bias(i,j,k) > 1.0E-3) S_bias(i,j,k) = 0.0 + enddo enddo + enddo - CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier - CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier + CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier - call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) - call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) - call cpu_clock_end(id_clock_bias_adjustment) + call cpu_clock_end(id_clock_bias_adjustment) - end subroutine get_bias_correction_tracer +end subroutine get_bias_correction_tracer !> Finalize DA module subroutine oda_end(CS) @@ -655,7 +655,7 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) real :: missing_value if (.not. associated(CS)) return - if (CS%assim_method .eq. NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return + if (CS%assim_method == NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return call cpu_clock_begin(id_clock_apply_increments) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index eb7d3a6340..dfbb3e0d63 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1696,13 +1696,13 @@ subroutine reflect(En, NAngle, CS, G, LB) if (ridge(i,j)) then ! if ray is not incident but in ridge cell, use complementary angle - if ((Nangle_d2 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle)) then + if ((Nangle_d2 < angle_to_wall) .and. (angle_to_wall < Nangle)) then angle_wall0 = mod(angle_wall0 + Nangle_d2 + Nangle, Nangle) endif endif ! do reflection - if ((0 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle_d2)) then + if ((0 < angle_to_wall) .and. (angle_to_wall < Nangle_d2)) then angle_r0 = mod(2*angle_wall0 - a0 + Nangle, Nangle) angle_r = angle_r0 + 1 !re-index to 1 -> Nangle if (a /= angle_r) then diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index cc4517a473..f1d6e6bb57 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -388,7 +388,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) if (sum(tide_ref_date) == 0) then ! tide_ref_date defaults to 0. CS%time_ref = set_date(1, 1, 1) else - if(.not. CS%use_eq_phase) then + if (.not. CS%use_eq_phase) then ! Using a reference date but not using phase relative to equilibrium. ! This makes sense as long as either phases are overridden, or ! correctly simulating tidal phases is not desired. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 2ff0a21196..d12d850a73 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1213,7 +1213,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index d88d5e551d..99dd38135d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -916,11 +916,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) + mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) else - mech_TKE = mech_TKE * exp_kh + mech_TKE = mech_TKE * exp_kh endif - !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c8166c47b8..be574b4356 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -308,7 +308,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di endif ! CS%use_CVMix_tidal ! Read in vertical profile of tidal energy dissipation - if ( CS%CVMix_tidal_scheme.eq.SCHMITTNER .or. .not. CS%use_CVMix_tidal) then + if ( CS%CVMix_tidal_scheme == SCHMITTNER .or. .not. CS%use_CVMix_tidal) then call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & "INT_TIDE_PROFILE selects the vertical profile of energy "//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& @@ -562,8 +562,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di fail_if_missing=.true.) ! Check whether tidal energy input format and CVMix tidal mixing scheme are consistent if ( .not. ( & - (uppercase(tidal_energy_type(1:4)).eq.'JAYN' .and. CS%CVMix_tidal_scheme.eq.SIMMONS).or. & - (uppercase(tidal_energy_type(1:4)).eq.'ER03' .and. CS%CVMix_tidal_scheme.eq.SCHMITTNER) ) )then + (uppercase(tidal_energy_type(1:4)) == 'JAYN' .and. CS%CVMix_tidal_scheme == SIMMONS).or. & + (uppercase(tidal_energy_type(1:4)) == 'ER03' .and. CS%CVMix_tidal_scheme == SCHMITTNER) ) )then call MOM_error(FATAL, "tidal_mixing_init: Tidal energy file type ("//& trim(tidal_energy_type)//") is incompatible with CVMix tidal "//& " mixing scheme: "//trim(CVMix_tidal_scheme_str) ) @@ -1434,7 +1434,7 @@ subroutine setup_tidal_diagnostics(G, GV, CS) ! additional diags for CVMix if (CS%id_N2_int > 0) allocate(CS%dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SIMMONS) then + if (CS%CVMix_tidal_scheme /= SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif @@ -1442,14 +1442,14 @@ subroutine setup_tidal_diagnostics(G, GV, CS) endif if (CS%id_vert_dep > 0) allocate(CS%dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif allocate(CS%dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif @@ -1636,21 +1636,6 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) enddo ; enddo enddo - !open(unit=1905,file="out_1905.txt",access="APPEND") - !do j=G%jsd,G%jed - ! do i=isd,ied - ! if ( i+G%idg_offset .eq. 90 .and. j+G%jdg_offset .eq. 126) then - ! write(1905,*) "-------------------------------------------" - ! do k=50,nz_in(1) - ! write(1905,*) i,j,k - ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j)+G%Z_ref, z_w(k),CS%tidal_diss_lim_tc - ! end do - ! endif - ! enddo - !enddo - !close(1905) - ! test if qE is positive if (any(CS%tidal_qe_3d_in<0.0)) then call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index c11bc9856c..4a98aa1934 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -643,7 +643,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ k_bot_diff = (k_bot_max - k_bot_min) ! tracer flux where the minimum BLD intersets layer - if ((CS%linear) .and. (k_bot_diff .gt. 1)) then + if ((CS%linear) .and. (k_bot_diff > 1)) then ! apply linear decay at the base of hbl do k = k_bot_min,1,-1 F_layer_z(k) = -(dz_top(k) * khtr_u) * (phi_R_z(k) - phi_L_z(k)) @@ -678,11 +678,11 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ ! ! TODO: GMM add option to apply linear decay ! k_top_max = MAX(k_top_L, k_top_R) ! ! make sure left and right k indices span same range -! if (k_top_max .ne. k_top_L) then +! if (k_top_max /= k_top_L) then ! k_top_L = k_top_max ! zeta_top_L = 1.0 ! endif -! if (k_top_max .ne. k_top_R) then +! if (k_top_max /= k_top_R) then ! k_top_R= k_top_max ! zeta_top_R = 1.0 ! endif @@ -1011,10 +1011,10 @@ logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_a character(len=80) :: test_name !< Name of the unit test logical :: verbose !< If true always print output - test_boundary_k_range = k_top .ne. k_top_ans - test_boundary_k_range = test_boundary_k_range .or. (zeta_top .ne. zeta_top_ans) - test_boundary_k_range = test_boundary_k_range .or. (k_bot .ne. k_bot_ans) - test_boundary_k_range = test_boundary_k_range .or. (zeta_bot .ne. zeta_bot_ans) + test_boundary_k_range = k_top /= k_top_ans + test_boundary_k_range = test_boundary_k_range .or. (zeta_top /= zeta_top_ans) + test_boundary_k_range = test_boundary_k_range .or. (k_bot /= k_bot_ans) + test_boundary_k_range = test_boundary_k_range .or. (zeta_bot /= zeta_bot_ans) if (test_boundary_k_range) write(stdout,*) "UNIT TEST FAILED: ", test_name if (test_boundary_k_range .or. verbose) then From 6da5c9b97632a0b9b9343d1b26e3b266fc3e62f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Jan 2022 09:04:16 -0500 Subject: [PATCH 132/138] Standardize code in calc_sfc_displacement Slightly modified the recently added subroutine calc_sfc_displacement to document the units of its variables and to follow the MOM6 code standards from https://github.com/NOAA-GFDL/MOM6/wiki/Code-style-guide. The changes include white-space corrections, changing logical comparison syntax like '.gt.' to '>', and explicitly identifying where array syntax is used. All answers and output are bitwise identical. --- .../MOM_state_initialization.F90 | 44 +++++++++---------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index f95192f5f8..22892817e6 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1242,67 +1242,67 @@ subroutine calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) eta ! The free surface height that the model should use [Z ~> m]. ! temporary arrays real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice - real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2 ] + real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2] real, dimension(SZK_(GV)) :: h_tmp ! temporary storage for thicknesses [H ~> m] real, dimension(SZK_(GV)) :: p_ref ! pressure for density [R Z ~> kg m-2] real, dimension(SZK_(GV)+1) :: ei_tmp, ei_orig ! temporary storage for interface positions [Z ~> m] - real :: z_top, z_col, mass_disp, residual, tol + real :: z_top ! An estimate of the height of the ice-ocean interface [Z ~> m] + real :: mass_disp ! The net mass of sea water that has been displaced by the shelf [R Z ~> kg m-2] + real :: residual ! The difference between the displaced ocean mass and the ice shelf + ! mass [R Z ~> kg m-2] + real :: tol ! The initialization tolerance for ice shelf initialization [Z ~> m] integer :: is, ie, js, je, k, nz, i, j, max_iter, iter is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - - tol = 0.001 ! The initialization tolerance for ice shelf initialization (m) call get_param(PF, mdl, "ICE_SHELF_INITIALIZATION_Z_TOLERANCE", tol, & "A initialization tolerance for the calculation of the static "// & "ice shelf displacement (m) using initial temperature and salinity profile.",& - default=tol, units="m", scale=US%m_to_Z) + default=0.001, units="m", scale=US%m_to_Z) max_iter = 1e3 call MOM_mesg("Started calculating initial interface position under ice shelf ") ! Convert thicknesses to interface heights. call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) - do j = js, je ; do i = is, ie + do j=js,je ; do i=is,ie iter = 1 z_top_shelf(i,j) = 0.0 p_ref(:) = tv%p_ref - if (G%mask2dT(i,j) .gt. 0. .and. mass_shelf(i,j) .gt. 0.) then + if ((G%mask2dT(i,j) > 0.) .and. (mass_shelf(i,j) > 0.)) then call calculate_density(tv%T(i,j,:), tv%S(i,j,:), P_Ref, rho_col, tv%eqn_of_state) - z_top = min(max(-1.0*mass_shelf(i,j)/rho_col(1),-G%bathyT(i,j)),0.) - h_tmp = 0.0 - z_col = 0.0 - ei_tmp(1:nz+1)=eta(i,j,1:nz+1) - ei_orig(1:nz+1)=eta(i,j,1:nz+1) + z_top = min(max(-1.0*mass_shelf(i,j)/rho_col(1), -G%bathyT(i,j)), 0.) + h_tmp(:) = 0.0 + ei_tmp(1:nz+1) = eta(i,j,1:nz+1) + ei_orig(1:nz+1) = eta(i,j,1:nz+1) do k=1,nz+1 - if (ei_tmp(k) tol) .and. (z_top > -G%bathyT(i,j)) .and. (iter < max_iter)) + z_top = min(max(z_top-(residual*0.5e-3), -G%bathyT(i,j)), 0.0) + h_tmp(:) = 0.0 ei_tmp(1:nz+1) = ei_orig(1:nz+1) do k=1,nz+1 - if (ei_tmp(k)= max_iter) call MOM_mesg("Warning: calc_sfc_displacement too many iterations.") z_top_shelf(i,j) = z_top endif - enddo; enddo + enddo ; enddo call MOM_mesg("Calling depress_surface ") call depress_surface(h, G, GV, US, PF, tv, just_read=.false.,z_top_shelf=z_top_shelf) call MOM_mesg("Finishing calling depress_surface ") From 9f0018fe304596b8b723b32b708cd6bbced50e65 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 18 Jan 2022 13:26:57 -0500 Subject: [PATCH 133/138] +(*)Change the remapping dzInterface argument sign Changed the name and sign convention for the dzInterface argument to remap_all_state_vars to reflect the convention used in the regridding code and to reflect the fact that this is always a vertical displacement. This change eliminates a subtle array-syntax whole-array multiplication (by -1.) in one call to remap_all_state_vars (this clearly violated MOM6 code standards), and it corrects an actual sign error that will change answers (perhaps from a state of catastrophic failure) in the code for the REGRID_ACCELERATE_INIT=True option if REMAP_UV_USING_OLD_ALG is also true and the initial velocities that are being remapped are non-zero. Also added comments describing the real variables inside of remap_all_state_vars to help clarify what they do. Fortunately the situation where answers change seems like a very uncommon combination of settings (it is possible that no one has ever tried this), and all answers in the MOM6-examples test suite are bitwise identical. --- src/ALE/MOM_ALE.F90 | 56 ++++++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 41ee555c52..72afad16df 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -378,7 +378,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) call diag_update_remap_grids(CS%diag) endif ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, -dzRegrid, & + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, dzRegrid, & u, v, CS%show_call_tree, dt ) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") @@ -732,10 +732,10 @@ end subroutine ALE_regrid_accelerated !! new grids. When velocity components need to be remapped, thicknesses at !! velocity points are taken to be arithmetic averages of tracer thicknesses. !! This routine is called during initialization of the model at time=0, to -!! remap initiali conditions to the model grid. It is also called during a +!! remap initial conditions to the model grid. It is also called during a !! time step to update the state. subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, OBC, & - dxInterface, u, v, debug, dt) + dzInterface, u, v, debug, dt) type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -747,7 +747,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(in) :: dxInterface !< Change in interface position + optional, intent(in) :: dzInterface !< Change in interface position !! [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] @@ -755,29 +755,34 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, optional, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] logical, optional, intent(in) :: debug !< If true, show the call tree real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s] + ! Local variables - integer :: i, j, k, m - integer :: nz, ntr - real, dimension(GV%ke+1) :: dx - real, dimension(GV%ke) :: h1, u_column - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_conc - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_cont - real, dimension(SZI_(G), SZJ_(G)) :: work_2d - real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: ppt2mks - real, dimension(GV%ke) :: h2 - real :: h_neglect, h_neglect_edge + real, dimension(GV%ke+1) :: dz ! The change in interface heights interpolated to + ! a velocity point [H ~> m or kg m-2] + real, dimension(GV%ke) :: h1 ! A column of initial thicknesses [H ~> m or kg m-2] + real, dimension(GV%ke) :: h2 ! A column of updated thicknesses [H ~> m or kg m-2] + real, dimension(GV%ke) :: u_column ! A column of properties, like tracer concentrations + ! or velocities, being remapped [various units] + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_conc ! The rate of change of concentrations [Conc T-1 ~> Conc s-1] + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_cont ! The rate of change of cell-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] or + ! cell thickness [H T-1 ~> m s-1 or Conc kg m-2 s-1] + real, dimension(SZI_(G), SZJ_(G)) :: work_2d ! The rate of change of column-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2] logical :: show_call_tree type(tracer_type), pointer :: Tr => NULL() + integer :: i, j, k, m, nz, ntr show_call_tree = .false. if (present(debug)) show_call_tree = debug if (show_call_tree) call callTree_enter("remap_all_state_vars(), MOM_ALE.F90") - ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dxInterface. Otherwise, - ! u and v can be remapped without dxInterface - if ( .not. present(dxInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then - call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm "// & + ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dzInterface. Otherwise, + ! u and v can be remapped without dzInterface + if ( .not. present(dzInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then + call MOM_error(FATAL, "remap_all_state_vars: dzInterface must be present if using old algorithm "// & "and u/v are to be remapped") endif @@ -790,7 +795,6 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif nz = GV%ke - ppt2mks = 0.001 ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr @@ -856,14 +860,14 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap u velocity component if ( present(u) ) then - !$OMP parallel do default(shared) private(h1,h2,dx,u_column) + !$OMP parallel do default(shared) private(h1,h2,dz,u_column) do j = G%jsc,G%jec ; do I = G%iscB,G%iecB ; if (G%mask2dCu(I,j)>0.) then ! Build the start and final grids h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i+1,j,:) ) if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i+1,j,:) ) + dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i+1,j,:) ) do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo else h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) @@ -889,14 +893,14 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap v velocity component if ( present(v) ) then - !$OMP parallel do default(shared) private(h1,h2,dx,u_column) + !$OMP parallel do default(shared) private(h1,h2,dz,u_column) do J = G%jscB,G%jecB ; do i = G%isc,G%iec ; if (G%mask2dCv(i,j)>0.) then ! Build the start and final grids h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i,j+1,:) ) if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i,j+1,:) ) + dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i,j+1,:) ) do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo else h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) From 03a247e4346ac3f21db516ed48d11202d15b9430 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 21 Jan 2022 09:26:29 -0500 Subject: [PATCH 134/138] Avoid divide by zero in horizontal_viscosity() with better_bound_kh - I division by zero was encountered when using the back-scatter settings (negative viscosity) in NeverWorld2. It appears hrat_min(I,J) can be zero. Reading the code, it makes sense that hrat_min can be zero. The division was previously made conditional in 14971b41024b96eda983 also when using backscatter, but then only one part of the denomitor was used in the conditional. - I'm not sure why the backscatter setup is repeatedly hitting these edge cases or specific line of code. - This fix uses the entire denominator in the conditional. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 6a9b49683c..323c0ceb65 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1308,8 +1308,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xy(I,J)) then visc_bound_rem(i,j) = 0.0 Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xy(I,J) - elseif (CS%Kh_Max_xy(I,J)>0.) then visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xy(I,J)) + elseif (hrat_min(I,J)*CS%Kh_Max_xy(I,J)>0.) then endif endif From e63c4055a4f12b862abac12f4ce4657495d0a7af Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 21 Jan 2022 09:27:59 -0500 Subject: [PATCH 135/138] Fix soft-conventional index capitalization in horizontal_viscosity() - A previous re-factor for optimization introduced some inconsistent capitalization. This made it hard to understand the code, especially with some arrays being re-used at different grid locations. --- .../lateral/MOM_hor_visc.F90 | 63 ++++++++++--------- 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 323c0ceb65..0249f79c2d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1003,6 +1003,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, visc_bound_rem(i,j) = 0.0 Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xx(i,j) else + ! ### NOTE: The denominator could be zero here - AJA ### visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xx(i,j)) endif enddo ; enddo @@ -1194,7 +1195,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%better_bound_Ah .or. CS%better_bound_Kh) then do J=js-1,Jeq ; do I=is-1,Ieq h_min = min(h_u(I,j), h_u(I,j+1), h_v(i,J), h_v(i+1,J)) - hrat_min(i,j) = min(1.0, h_min / (hq(I,J) + h_neglect)) + hrat_min(I,J) = min(1.0, h_min / (hq(I,J) + h_neglect)) enddo ; enddo if (CS%better_bound_Kh) then @@ -1217,11 +1218,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (G%mask2dCv(i,J) + G%mask2dCv(i+1,J)) == 0.0) then ! Only one of hu and hv is nonzero, so just add them. hq(I,J) = hu + hv - hrat_min(i,j) = 1.0 + hrat_min(I,J) = 1.0 else ! Both hu and hv are nonzero, so take the harmonic mean. hq(I,J) = 2.0 * (hu * hv) / ((hu + hv) + h_neglect) - hrat_min(i,j) = min(1.0, min(hu, hv) / (hq(I,J) + h_neglect) ) + hrat_min(I,J) = min(1.0, min(hu, hv) / (hq(I,J) + h_neglect) ) endif endif endif @@ -1234,11 +1235,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-1,Jeq ; do I=is-1,Ieq grad_vort = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) grad_vort_qg = 3. * grad_vort_mag_q_2d(I,J) - vert_vort_mag(i,j) = min(grad_vort, grad_vort_qg) + vert_vort_mag(I,J) = min(grad_vort, grad_vort_qg) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - vert_vort_mag(i,j) = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) + vert_vort_mag(I,J) = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) enddo ; enddo endif endif @@ -1254,11 +1255,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Kh) then if (CS%add_LES_viscosity) then do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = Kh(i,j) + CS%Laplac2_const_xx(i,j) * Shear_mag(i,j) + Kh(I,J) = Kh(I,J) + CS%Laplac2_const_xx(i,j) * Shear_mag(i,j) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = max(Kh(i,j), CS%Laplac2_const_xy(I,J) * Shear_mag(i,j) ) + Kh(I,J) = max(Kh(I,J), CS%Laplac2_const_xy(I,J) * Shear_mag(i,j) ) enddo ; enddo endif endif @@ -1266,11 +1267,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Leith_Kh) then if (CS%add_LES_viscosity) then do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = Kh(i,j) + CS%Laplac3_const_xx(i,j) * vert_vort_mag(i,j) * inv_PI3 + Kh(I,J) = Kh(I,J) + CS%Laplac3_const_xx(i,j) * vert_vort_mag(I,J) * inv_PI3 ! Is this right? -AJA enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = max(Kh(i,j), CS%Laplac3_const_xy(I,J) * vert_vort_mag(i,j) * inv_PI3) + Kh(I,J) = max(Kh(I,J), CS%Laplac3_const_xy(I,J) * vert_vort_mag(I,J) * inv_PI3) enddo ; enddo endif endif @@ -1281,40 +1282,40 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! stack size has been reduced. do J=js-1,Jeq ; do I=is-1,Ieq if (rescale_Kh) & - Kh(i,j) = VarMix%Res_fn_q(i,j) * Kh(i,j) + Kh(I,J) = VarMix%Res_fn_q(I,J) * Kh(I,J) if (CS%res_scale_MEKE) & - meke_res_fn = VarMix%Res_fn_q(i,j) + meke_res_fn = VarMix%Res_fn_q(I,J) ! Older method of bounding for stability if (legacy_bound) & - Kh(i,j) = min(Kh(i,j), CS%Kh_Max_xy(i,j)) + Kh(I,J) = min(Kh(I,J), CS%Kh_Max_xy(I,J)) - Kh(i,j) = max(Kh(i,j), CS%Kh_bg_min) ! Place a floor on the viscosity, if desired. + Kh(I,J) = max(Kh(I,J), CS%Kh_bg_min) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) then ! *Add* the MEKE contribution (might be negative) - Kh(i,j) = Kh(i,j) + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + Kh(I,J) = Kh(I,J) + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & (MEKE%Ku(i+1,j) + MEKE%Ku(i,j+1)) ) * meke_res_fn endif ! Older method of bounding for stability if (CS%anisotropic) & ! *Add* the shear component of anisotropic viscosity - Kh(i,j) = Kh(i,j) + CS%Kh_aniso * CS%n1n2_q(I,J)**2 + Kh(I,J) = Kh(I,J) + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! Newer method of bounding for stability if (CS%better_bound_Kh) then - if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xy(I,J)) then + if (Kh(i,j) >= hrat_min(I,J) * CS%Kh_Max_xy(I,J)) then visc_bound_rem(i,j) = 0.0 - Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xy(I,J) - visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xy(I,J)) + Kh(i,j) = hrat_min(I,J) * CS%Kh_Max_xy(I,J) elseif (hrat_min(I,J)*CS%Kh_Max_xy(I,J)>0.) then + visc_bound_rem(I,J) = 1.0 - Kh(I,J) / (hrat_min(I,J) * CS%Kh_Max_xy(I,J)) endif endif if (CS%id_Kh_q>0 .or. CS%debug) & - Kh_q(I,J,k) = Kh(i,j) + Kh_q(I,J,k) = Kh(I,J) if (CS%id_vort_xy_q>0) & vort_xy_q(I,J,k) = vort_xy(I,J) @@ -1352,15 +1353,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then do J=js-1,Jeq ; do I=is-1,Ieq - AhSm = Shear_mag(i,j) * (CS%Biharm_const_xy(I,J) & - + CS%Biharm_const2_xy(I,J) * Shear_mag(i,j) & + AhSm = Shear_mag(I,J) * (CS%Biharm_const_xy(I,J) & + + CS%Biharm_const2_xy(I,J) * Shear_mag(I,J) & ) Ah(i,j) = max(Ah(I,J), AhSm) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - AhSm = CS%Biharm_const_xy(I,J) * Shear_mag(i,j) - Ah(i,j) = max(Ah(I,J), AhSm) + AhSm = CS%Biharm_const_xy(I,J) * Shear_mag(I,J) + Ah(I,J) = max(Ah(I,J), AhSm) enddo ; enddo endif endif @@ -1368,13 +1369,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Leith_Ah) then do J=js-1,Jeq ; do I=is-1,Ieq AhLth = CS%Biharm6_const_xy(I,J) * abs(Del2vort_q(I,J)) * inv_PI6 - Ah(i,j) = max(Ah(I,J), AhLth) + Ah(I,J) = max(Ah(I,J), AhLth) enddo ; enddo endif if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(I,J), CS%Ah_Max_xy(I,J)) enddo ; enddo endif endif ! Smagorinsky_Ah or Leith_Ah @@ -1382,7 +1383,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (use_MEKE_Au) then ! *Add* the MEKE contribution do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = Ah(i,j) + 0.25 * ( & + Ah(I,J) = Ah(I,J) + 0.25 * ( & (MEKE%Au(i,j) + MEKE%Au(i+1,j+1)) + (MEKE%Au(i+1,j) + MEKE%Au(i,j+1)) & ) enddo ; enddo @@ -1391,31 +1392,31 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Re_Ah > 0.0) then do J=js-1,Jeq ; do I=is-1,Ieq KE = 0.125 * ((u(I,j,k) + u(I,j+1,k))**2 + (v(i,J,k) + v(i+1,J,k))**2) - Ah(i,j) = sqrt(KE) * CS%Re_Ah_const_xy(i,j) + Ah(I,J) = sqrt(KE) * CS%Re_Ah_const_xy(i,j) enddo ; enddo endif if (CS%better_bound_Ah) then if (CS%better_bound_Kh) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), visc_bound_rem(i,j) * hrat_min(i,j) * CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(i,j), visc_bound_rem(i,j) * hrat_min(I,J) * CS%Ah_Max_xy(I,J)) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), hrat_min(i,j) * CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(i,j), hrat_min(I,J) * CS%Ah_Max_xy(I,J)) enddo ; enddo endif endif if (CS%id_Ah_q>0 .or. CS%debug) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah_q(I,J,k) = Ah(i,j) + Ah_q(I,J,k) = Ah(I,J) enddo ; enddo endif ! Again, need to initialize str_xy as if its biharmonic do J=js-1,Jeq ; do I=is-1,Ieq - d_str = Ah(i,j) * (dDel2vdx(I,J) + dDel2udy(I,J)) + d_str = Ah(I,J) * (dDel2vdx(I,J) + dDel2udy(I,J)) str_xy(I,J) = str_xy(I,J) + d_str From 65998cd3158cb68d65c41a01296266af712e472f Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 26 Jan 2022 09:27:59 -0900 Subject: [PATCH 136/138] Esmg docs (#57) * additions for stochastic physics and ePBL perts * cleanup of code and enhancement of ePBL perts * Update MOM_diabatic_driver.F90 remove conflict with dev/emc * Update MOM_diabatic_driver.F90 further resolve conflict * Update MOM_diabatic_driver.F90 put id_sppt_wts, etc back. * add stochy_restart writing to mom_cap * additions for stochy restarts * clean up debug statements * clean up code * fix non stochastic ePBL calculation * re-write of stochastic code to remove CPP directives * remove blank link in MOM_diagnostics * clean up MOM_domains * make stochastics optional * correct coupled_driver/ocean_model_MOM.F90 and other cleanup * clean up of code for MOM6 coding standards * remove stochastics container * revert MOM_domains.F90 * clean up of mom_ocean_model_nuopc.F90 * remove PE_here from mom_ocean_model_nuopc.F90 * remove debug statements * stochastic physics re-write * move stochastics to external directory * doxygen cleanup * add write_stoch_restart_ocn to MOM_stochastics * add logic to remove incrments from restart if outside IAU window * revert logic wrt increments * add comments * update to gfdl 20210806 (#74) * remove white space and fix comment * Update MOM_oda_incupd.F90 remove unused index bounds, and fix sum_h2 loop. Co-authored-by: pjpegion Co-authored-by: Marshall Ward * Fussing with zotero.bib. Getting a warning about a repeated bibliography entry for adcroft2004. Rob thinks this is a hash failure. * Still fussing with zotero.bib - it was complaining about the (unused) Kasahara reference. * Several little things, one is making sponge less verbose. - Pointing to OBC wiki file from the lateral parameterizations doc. - Using the MOM6 verbosity to control the time_interp verbosity. - Making the check for negative water depths more informative. * return a more accurate error message in MOM_stochasics * Working on boundary layer docs. * Done with EPBL docs? * Undoing some patches from others * Cleaning up too-new commits * Adding in that SAL commit again. * correction on type in directory name * Added some to vertical viscisity doc. * Cleaned up whitespace leftover from porous topomerge. - Spacing within expressions was uneven and made multiplation look like POW functions. Leftover from merging NOAA-GFDL/MOM6#3. - No answer changes. * Fix out-of-bounds k index in PPM flux - An errant use of the porous face area led to an out-of-bounds k-index reported in NOAA-GFDL/MOM6#19. - Closes #19 * Adding Channel drag figure * Take cite out of figure caption. * Copyright year 2022 --- docs/conf.py | 2 +- docs/images/channel_drag.png | Bin 0 -> 13890 bytes .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 2 +- .../vertical/_V_diffusivity.dox | 2 +- .../vertical/_V_viscosity.dox | 72 ++++++++++++++++-- 6 files changed, 69 insertions(+), 11 deletions(-) create mode 100644 docs/images/channel_drag.png diff --git a/docs/conf.py b/docs/conf.py index 5d84b3c37a..4407d88356 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2021, MOM6 developers' +copyright = u'2017-2022, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/docs/images/channel_drag.png b/docs/images/channel_drag.png new file mode 100644 index 0000000000000000000000000000000000000000..a665034ff08f7fd6dea72ef1d085704cafcc4abc GIT binary patch literal 13890 zcmb_@XHZkow{Hp|bO==`qM>&br4tYV5u~?B4WNQjmEHqNlO`abAiYWrNUxzNB2ol} z(1Rc-p$SM8xCebR?>}?rzWe2UU^uhSE^GZ(Icu%G60NU$la`8|3Iqbt-qKVv1cAWW zz+WE)IWS^=?P@UakJ4T9jtB5h{_GFDc{fQ57(DN(j`lQiyYJ~^`}iKn$Hzzffvb~; zy{-E_aks|~8S9GdAkan7Ew$^$zOUD2`~r=Cx1IhP=LM^(YIX@PLL$E@geOEr?d$&k8y2Bz1|gA24bMVPtQ3nuf_tm<@Ut`eEfR~& zUfwHM=?_-9wG|90*;I4`4GXM!i6jke3l|3sCGRQ82ecXHxJ_0k-EC?;wC^x#-kGc5 zdG#^*8WlI9kHw8ohCz_mq?3(5!H?TRM0>-2_SuD;5sx_w%DqnEhiMI6d#0b%(S<7? znIYD+c-Eody5*D9#RX6ten~f&E{Brv!n^!@iO#GKw-Z>pNNEWC@XCuS`R?lU#qG9- z$s1o2Z{O>`YhM$X`373=wY9H_DeSt*>pxBPwc_;=|Hh5dE$8= zWjR{9E5{oNV1M!kFZ}(aKzK#VaPIw#)>OqGk)#A#UXzKI(2)syYgazfv2+_{8NR_T zrEc$XLzp*r8IMWm+0m^HkA0x{pidkOGY9pem-9Cf4~A$%waN`8I)x9weMiuwqjh_h ztfTK}iWitrLk;0`maee12<+ZeU{UWF|K5y>d&jGB-fW|c`OACD>Z-Tqc?=dJB3f7+ zWXC4#pFEiICp?3x1hMUndv5zV8KlKWb=_1gK6mcLG!K!S-~Mcm_Z*f&>KlAXvH zd&#@zz=w)Q>-AUs0_`V%>GavpCifwe?on~~r9d!(lCht_NkV9HTPtHRd<0#+9=72D zH~ZJDBP!a&=SKUQdb~Kv^W>{o9aawVSj`q?8tN=n4A-k0i>KIzE1WiZOY`|i#!FP( z;G+;p2!WD-;E3FyeUVsTe%UoAFm>9L&utEzr88?o8~AL{ElLy4jQXVyiG_LJnvDl* z*j|6jH1_O4r|N=zxf96eZeNK&UCh0_oH%b_`u`Uz-LjKf`Wlv zW#w$9{EQ5$@zosRlBj<;}0lMJQ zDcw|x>ibB^OMWc^IEXLpKF6lEsG}*|NDVM!!~I3m zOWwLm#M%mWU!JC8R$my0IzN(;nksvh{gyC>9~@~faw`5VY^i>6P5Fs%PL$?3!NB@C z6{4i!B`Ji(^DUk7qg69Jj6lThP%A`7^`v(dA8A07LwS-Kj_f+OkeeLDE6%AMsnu+V zpJ81BQhSyIyrPc$wj$tGSS#ocXkSWRj|W*}#f&OqmVI7tYxIfUd!i}h z<;dfeSmR}p*KgfgVF~^%vX|9$Q;qj-7b8lYkb@P*(76lZQq=ModVkWZAPxG0kM0a} z28eQc8Ha^J6@t}^uX&ug*-K2u`^*gub2z~SC>HIGsO{0k@V*%BlpABeH}e~8y>H>UZv+8Pz&kSP1;aN?WkmGjK1T1W6$ z^D8Be`-4xdyeVx+MN+^wCUJNxV#qc2+`ObyYMfSCsg}MuJG#?f=P#cwLkEApOHg{x zT+7M3`|3;!YN^7+RR$ehWPpXwT=z@9pTPlagZPyRyjBY=-b5e}bMGz%UL~pkI`fSI z_3!{t-`k$uH`$Vz5R?@^A`;BckSY8-Q7BMNt;grTt^bc5klR{RQJGIbny_@BA80ssMyE_2yuRuhad%%8bBbY^3dMLI}?{^iFi zGk`w)AB@yXvc=;5ZYOp|ZjaArT5hqbGu(lPzYJ*qW#B&|oEBM{I#U3qr?F>P|4#u= z%a3^Px8J>(6#>;_{+*g|Cf}$35h00B&NCIx0fVY}T>mgm`in8!OzzlU%`xo%zam#x z3N#NBkBEw@Wt-Xjyd@8i&oZ-V&;a1#_zySshhk@O*nh0~H~v{^+5WG?U*JXV?y~ zH?GxVv|m_hT|^`@2!qyLX0&;Uk;-aNdVt6@s!i+d_m41Ng&P;*@l?D>Z4c`~CwW?)u%w^lGc>W5x*jk>K6KzC;N5H&VVT9cQUF<1NU=5`FDCUA~C zH8-{jN*52^Xoc?0PQ4pdS5s>qGudyAs0e&6zc)Jkd|Nd-O0(9B1qGVxaXJ2TG-v+H zTusftLScTJ979^=W!zkITkid;d+p4T)HXAr0K8Z^;igrC#bueop@8v}w9LO{-WLPL zH$u3jT|VB)1<;;s<^afq(8|)4Tfk*zUX)z{j_LW$8;F9q!VS$7Dk=wW{hjB}h{8Cv zfBhzld&FZI5+wfd1sA*fMSvl|xz{zOP3iIydzB-uIn`K~lxsR(cS0oMRvzqw{!pNw zEZ|ecq<7?F%fII@B}8dbxajRWledpI`y8!p4u#yWPytjgXo?91Y5;FQhDRWC`x;|^ z<=)UXKS~x@=Cv^&Ip4HgW0+I^h|~S*3cz4&y-XmUKeL^T(043SNijzuMJvyMpe&qy zN{?s3h7XoibtUn&NhC%^sad;qFH7LLK~DE9gXNs3#z=pG{4E`bPn~%H=-E4}#@}P2 ztp&i;JJMYaLhdpELS}^-;8=6*&KTeYb^+|>Ur3g}aKGDUo%-hM^&!d#L|>St@t_aX z4a^EkvmzfDkn_zDXJ%GG=KiGwcqfK0#17Q?9l7j(m+;t>w!)<*u=)TtcNu=})%Wp0 z3U^Ij&Ip=EC2tL^se?Ht|QgrGyTi zeTPiNMV9G*=_J3Y05&w_P>zequ2fy z(46Z`z>iC(5!NDS-;4eP4`c)A6eP;fzQyAB@Z)id@W0{B2juPKgkh4;Y^cp2w3ytnpC?fYJN}!P$d#38y1FdM&P$2tw1v4_fWq@H->4Wp78s6Nz#sl@;`XmN z3k7mb78e5AV#E{=O&BTn`}ByfJunGMkGEar0bg-Y$gQ8$YD4y-P|5oGk$lCuAKCMD z!cv^1?7(23tPEGsa52XaNz*3hs$U1$A6jl)qFeF2ERT7lwepU>>nxD^AcgLsgO*M6 z3en-{Fq1>qcdHej`fp{*?3%W(52^HqCgQugz6Xgli2kffxusN(d7Jhmj#t+V?yRja z266thIW4AgW3u{wPJMEXXHov%qiepiRfs?I**XNi2A7`BZu;(Iy{_5^6Cnb$vJ8~@ zjOAff7fn95urwa6HPV|-w4^izSWwXPpvJ$~RuE_0He5;gid8s&$Y6g(!OXKDr>&Fv zMSEKGcbeg+UoD=O?vRqEG|ER{gxfWSg)W%Js)^4|O|4aRLI=|&?39*2eD*=p;Mdfg zlkz)+7ANYL!0NcI8_qzft6N#Q6MTS23)S!I!01 zh&bajzpNa2x}UJx9z)KlsmOwTavmJmAG$iAqf%Q4x7Li(mgH&6k!Di!y5VRsiLh|IAGtfgr%EM&5dP(in=x-k$0u zsB=gu)o1MrWT~t2eb_vp*%#mB0R`_$$&y50%3fBes`Nl5DX8Nm%NsE8p*7s1G_Q+D zk2%6Ac}jk0_tNI$$!f2HL5CR571}t|qnqcFo5TfyB0l_Js*v0AJP@v`26tL*`Xfte|>C@6U`BMlF;ezXvY%)&=fonVvR@^y_}|%wG!-a zmSaEc(;<^KR5?%>>VzV4?$$q#hq@icM1kdu3QYzSt8hy)#R#2J=SxQY{E6;_0Jlhq z;Lm^s`Rw;9U&$V_=$Jk7$cG$MsPT@ga-qTr2cWV>I{6Q|Z{9e}O9j+hL>Joh->4q~ zVT3p52qkYT(EUZxJ2)Xx&vVMN^V1$&>m40OR>d6BzBUfMD#6-_zB>I#dVHs^NWF#Y z&pZ2{UM-l~v7fICihy{8X5jej)2nR<*DR#f)#>2etL_Ki=@Jy}F4ZVm6<)hGJ3b@y ze9m0$vDnT$R2nIKZJ+pdsM#hl(>Ko|+RHoI{MLEOPjFZGY_Doj*6n3yEiF!dof@3q zicn;8^BQ-`kC}%~Z5vYjQOaRai%nWTSCrHak&&0Krl@hoc5-1;d!fo9LRaA#+9rtHJgfYE*d zv)#?WgXJylN=OK^YyD=f3*ceh#(-*L~Jts@{JP; zMT$>6iMW0j2`j31R(G}Xyqbegoo2^@8(Xt$LI3&P!q@GR*a5)#|BXqF1y!=lsR;S zSlSR*Wfjbi;d-%*RMrr4X)706+S$kP)ZgfZkaB4~}?r`p%HPYsKOQzY~;@96y z?Vu2GpUPO+AS@XE#V*FBQebp=x#mh_Y3XLT&f(aXMX|kom6K9rl9L}B3P#x4HEXra2@W9mm_ zPM@9e8ijS)4n`*5-3PAGNwhw1$sM}x93H;D;fIktr9mdy`;D(Ht-xEKSRg`vYQGYx z9@X^_ss5;^Ked;#S;JS5&gnptF{);EImB~L}qwg3WM zBX@^c0YLhcG4gcI{(hyyaYZgXFxx*iQWh)NILfB2a6q|P}4 z)17Z5aQ}ULc&YGIyaFA0IGnKs?o$Fmd_a0?Ah+pTsNF3LO6IauXw=wXGsQ!xh~x@qlI&uAH`{_ZNv{W2=TRraY_}f z`DI+X;eRl8xnL6!9WMBE$ltkc=?KVszQx#1*3L!@p@GVnaJ|a1w6i-_A+OU^r=-00 zo$SoEbjyQFOV&Vo-lNLg1t-ejA)F2uvV+Khv_P-hfnm%)J;v)zik;Pi^}K>zA7N4F zsg%?z5z41`R_1^*45O_9B{weoW&*iz({EFPkIkNMk(OxaKu$L7HO(ruGwd*#O2p~A zZ={M|2Ko1c8jNZdkeBna<}stnurZ-6k2rlvVtb8KSB2i0%f#SF(~V_TE#q<3rh}XF zZ*Z^VSv2Cd@>jnJJGaFG6#(8YU>&G~eCeC4KtTKqwJ`{k8+1qY9+6sFqxqW!1c*f5y!;is%NJdpL76IZiB03loW}1u9~|Cc$_%Xb3nb7pyB!i8|mVFy4Ch zcbk2%TPJ_^G zN^h;fD*`yA2^5Vw8DSy@uYn?r-F0sFZ7X8yFH)06{0frYfSkNG41apSr{#HW=hxRN5?j>QUkHi=rJiV5xL$8C`Jd*2#Ew5O@y3fUM|#4~P+&%7 zDscNY3?$n8fdp?QW3-syXMpMNd%8+_pA=UPe69*+xe#>qIYb?(WuMKrI)cykOMq%? z@#h@~S`rh>-L+iXrOcl2)nP{31`A!d5rac=w!Qedw($*`z%G^ zpCa_3;QNrx^ksAiMnuG{D_WpyY2a0eA@K5Y?q*+{KSmt)(WCsFBhfA735+`DjnK=a za4XeUJdALv?CCq<6q@weIdvG6BTu1~m6 zWuvZyXEe{8>1uL-k8Rn-#zQa%xDl`(V(7(>%+~+ZW`Ds6&#id$9Zzm17x{!MRcoRsSs14m{QRn-(&KIJh|MWWHGz&i1W##)tc!CilqMg>& z>i4Ui?)g7u?QG=UPj%>^;0T-fcABh0#7)75Ph8;EG&52M*F3>M;~9kVR2+_xdmvdS+BlyQzq3IfEX~ zG`QChTYvftzkzvN~5-&U{OwOLqjOU_4F7iy^YqeRP!rOaPYyYW7gK9~=i!WW1O*$1y( z_T#K$Og|}&`bxn z?tXL@=j~2C5qcG+37Fr(hWN#x7oB889ZvY5GWU9$%-= z<*6_D@xDy@ZLC_h64evhB_Ll}90Xc}wd&dPe9ES$SLVFk=il|HIXFIQQ7K%n){@?G zX+jUw0_GkW#*pygZLorW9w%@4CVpJ;h!P{ZiK3+)gZTf*#b}Lj0oOQZz9s#Hd($Q> zr~$TP?L;m33CxR3EZ&T+Bw^kBcbV|(_zp+sT9E%{=b22afj9LV(6j*HO&0#Avjt?ftn^+M>HiMg?G16AVq}Th*jQg}&h-C2C#(Vno;o z27X(Uw2BP{rJ|gGMV7*_WE)B;;*&3=z6ge7Zs~XkJ8cI z1`zFogs)JG0QXNpaptRA0$=+cJFn!>ROfC+SKSQ#**8_QSba%_R!4_L)RMxY9?#Zs z&iJ7A%k_0yhz2A-6wx=8h&Efr7+x}phpFuw8+$5g7FN>LyNHnf+zKu24*Nj+;h|w? z-DSU4@g|$h))|PiE^2*!oWDT~y&s<5B`|wJ!wFZ6H&Mf+4DhFC^vf=D5^5>iw^Hy_ zf^DXu18eN`vE8g0Gf+bGI=PlXqRAEui@r5oO3It#_MqHyn!}w?FtoWHMji9)S^dU5 zs`qPy#EaD3U7w-yH+?5I0bj>d-!3=DS~REz1sxrI?TgR}YUA2iL3??v9M`+Ny;v)G zyUoGNi&7tAeE(O2Czf3_XWG4#pT#ai6E^;S(f(^+_ODsjLAzIz`uiW8@K=cmc-&(3 zl^nWWq4^Q*wHsR%ZZK1opY@mVm-^OJL>)Em2HrP7&~Vc!tda5D>?$$9EyR0=>^PoN zlx2}@q6*DnX1Rm)FWfk)XqrGdxT<^|n_Np3(>H=<$V?rJS%?l#_e#5j#c>!V0B@?r zEEvChH5oZl@vyM_nY%da?HR(w`jE?Tp90T8VA1F9O(lYl_{Tsy-&e}kl#lAh$xToX zsvxp7FExeTBkBUiaJG`cim@E94+a*SiKLNjY0wpXU+c2H&(3%XyO2duS(ci~3G0;bi+{r#M)L z>?`(3J-PiU$|z|nxF8!l=Vd0l$S}o!8{4)=cf!#|CXk2=Ih{S>CN$SAxPSC?KKAz! z$!iaml~f$<7Y^(p8I{`|iMa=Ep)ZYvye2MXps17BTTSZ&FazR*mJfPdO$g%n?k&eIaM6Sj2fA}Pb4Gi;<=nM@w7Qp zZVjx%Rz7#;n(k@~js3opGELXRA${*2>s8=#{6W&pURDkpWquOlltx1R@q9N6YUB;M zGjhe8*xzUW#uXQ^Q3o=wAv^p{o#UIR4>YG#_pLFsX7_eJ0kU@4L&ugG2kts)J|Kn| zNn|D35pNKCYn9*&n?Ld?mj<599n&2~dQfRntVIu0q=$MH7oNBm7P@~ia9^#i=W@q( zX&`~*%j$qq`q7%Hq0|?#s0#r!z(*>QyWTa|IcltQtPovx-~Tbk)S>2FyF0;_^=dCy zvFp`nuJ8oU-YRTDbtr|4101!-$>|Xb`#ijMKJL}~zN2tj4X8);_Whf7{Ua}}yhDKq z;XMs?X30P{;wKnbIW9%;i=MNWS~QyV?QV|E^6lamdp{(OCVYa&<6X|PvUM-^No(em zQqiGg@yKUSW4dnoe+w#q90XEuNUU*w<;A1)i)^)JW4GhRiDwHJ*=w>--KmwAZ$x%c z3IM_DSo7xt$;4Oy5+hReci&(-QRnRsD_^Crkmy6O-SqT%&P~z?Sr(`H)oFjv;!IIz zAYV(>wRK~)VT}e_+ME+y2VFd zq#aZ56E=Q0s26Ym)LHC7%dqfjKHJ+jps$0Q>wuD^L`lu>9$iAuf4?(5ho<=SzAbP&=lWQe+yV_OK8hYv zMagSe4{?A>fMpWR5#ZnhZBkgva@IPX@}T!x2pOv^wR_d%WK}jTJGznK{$Q;MT&;%< zpeuX|h(gx811|jNguATw=O=hO9Gp6fdg({U8MiQO_`QBYA0ahVYZ@|OQ=or4NKJ8#>70$cvBdb!1bxlPL&dG={*-Q&mG?Z^=*a6sXw<` zy1(f|6Vl+|!D<|ALd!YJfQ5yHa!`rwWLE}=v>F!~VF{X1KzJAIPpd$`LruI3N>6td zAO4uKnYrOPwk6b^x+4cCaN}YsOn{!o4hn&+lCsigi-_=qeHR{S$eJB7QpJW7-oB?~ zalWOXCn#%bYXT-qPtC=FRC@Tr>rJLlmKD!UwXOKBn_)zZnPw0zN4yd{mQTA?L^a`k z>Z%-AFeeAUv}oy>NPA(JuSk6>9hkX;9HaFSkfg@(`F)}U(Qr~YWYgN5Tv=^)0;w}6 zTI%m>4v#@SaITG{&B|wzuAGWTqOs=?`k&Q!&A#|tvL$+V>p)PhO3lvaR~xuRt)0v6 z#%SIZ4CK9S-CddOA+nBr;zc4p6ImUZ)=u?}w2RTa0QC3~zCceyD-_#GfBy*Bm?#~M zZh@h21X*GNc20okFgy$#JYkPGZdoz4zOcVu(c^MR8wYnyX@yNId z+}w|aThvmRR(#xfi)6F|1P=GHO;hu29{}{WWuu;@tg5jqm4rxa&Dl&0tmc#@Z)CJ6 zzj|#yr+rqVXRTe~&rUJ>d4VK2Gb%|h9S2k217|ty{g|wC|MiYlwP9u{6DN$kln<=k zx#Ue5zKzvcyKua3Z?WgnMdthGQAa;Na^`I3@0c{w1-RntU%xs|x$b|$-byA`h5T;t zM2-jnO50+Bw4GM5_zZbjU;4*V=WqvRzlYPAvoRxeNrPf&ZuxN13^RJ*W#Wg<@T z_$sG6R>#z;x@){ETGN7xJ32|PnpK}=({<852+L}2o{p{|d!OLb_>HRM&9AoS$h^%& zM}P8`$)9G93UYNIi@vt_L;uKkF>6<7W7uw3SuuQPjurz>G2y8<+(iKns#ObjdPE}N zI?Yu8gOQmlms3Te0Mx%6bI4M1q-V~u$ng5Lq<<}26MnPKnOnqfLoLK80}vA9&^OJJ z2GYQY6{b{pJl&mPTW_W|H-`w8YVH7DLwCBeu`P6tXf5?&2dn|E!wZO7kUM1F%U?(> zpwD4SoHg9n%-d_y~c`bObfdHf88tO;U9F*;P)$D|Cx zQVW%&$?UC62$TP7??hAsXF;s z$*8z%dx!@)1r*op(s6a)yrGpj$6)(8Dqs< z#<968NNaXFnPC_<5x7t`Yiy~og~ED5$ZacoO*MI-8>`Qm&s}_su^B-~-Q7ovK23#^ z4oEh(W1<{fK0`|B0=y$YdaJpNA{XxzpLzaKdX? z6F5*wlMix_DE)AV0M^pN10qda^7C~aQn)<-L6JN1bACDM_n#8?Y zD?D=!Bef8g-aYc6ge8T-Dkz4vb5zf1@VOe`Vt9SB;7cGlsH2Pgk}nG;f0^8#`c-hx z`#7=bpa!uyso++tdtTqQY^cS)MXGI$b*3ikZB(%)uD$^c_Cz>ujCOjY>(E_S- z?Pqfp0Ge|R=tM!{WV@tAzl=~?g4!4oBrG!j!icyt>Vj7d_5aMbcs9$EcN0eBUCs06 zx8t)8BuXdt)b?L_H z^l+cR6m0X$H33_oU!#wM1r5riM!vuxb=?Wm+@-3I(>3 zi0d)Gu^q~z85Arv0r_H=Y)%dS0hE;$2Ah|Fc&w&|lg*4b4w$$R2i7e(x^5g-7bO}s zZQ!xJJXO-PwKbh;N(PXQkYaxss^gd$ufQ(;mK?+5eMylzFZj6J5U4}ElG1#*VDzTKN;Rr6S$EWF5=`FlOu69}*w75MOv2y%H%DrWh#(wG^aHwPLwA}2ZX zJaZWM9ZDk{Y?w_Zm99T zVUXpd&P&E}wfLUg7mYRKS*D_%$90QFEe(b%?R~O+#8(AqKkpMVNdzfX0da2b-F5?n zRIROAFvzsl5%LhaJ{DGrWBqKry2X$=5f+!j5xe(##5$m}{La{w^s9Xl-r6SsTv7DX z>rE4VE_Y>u@AHfavk&_hlzh+_HZhq1t{>|!WG-?8Kcd(#2gyD+E-NWZX#}%}>JWZ3 zePQ>4lA}RfKCg8=XF@`(R26|tT#Xl#k4tGRwhc9&h|8Xc@*1V>o>Dh6C6Bz2{_y+* zR|DTOMAfK5p*V(8;6|z0V{JnWO)BAZ6M49(DZ6w|_K&-QP3=Z|J=GI3Jpiyvrq9F< zq~IBg@h7Sz z)bE(x34yw`y0n4oNvlAWRa1@GF8@anhBU+#oe5p3)Is~qfUbz0H%3#~_fE1{`OI0hu zwQcuRfxa`9xO|0CR<=n;%k{Wn!D|JVYRFXoxLc)JO1P?q(VNg|x_{v+#m9arx0IB% z1oevkAtqF&SfV(R5muHomEU*VjwbyWUi7|L&u?WGgt&7Kp6C_MkPnjq@4V-Z{WRM& z=GxzA=cJ|Fp{^_utizQZrNdymQgV5lh{VPRAnRMMl_&UF{0TldtD@xwQTXR9K2qK} z*f6MulNODZLt|KMD@yHhUb;+a5$Y?RudKMT^4y%(hdSk6U&4?^d&3Zhou+8V+&iY^ zBBr(N1wa{COplfSg+a(&WXck5+K_U{Pbu12k3 z`4HSC96tg|cCH+ox{vz{K-4)10^89%x?%dFp_S)P z3!4!$hp3|7v!>-mHENuE({V+lvPD>3`N!&Q6==2OcGhv##jhSF8dIjGHdkzx6i4OW z7)~Y-v`_suhWxVUB8|~>yk0`FD9_3ZXARxRiRB36km*h)?+yv+58u4@qUn^fqxgUe z3?m+}K(>Yx(5k5h*u($QR{h`GqW@n_*fXc_CC-g*?djNJ;P+pkTk5)Mm8zJq{{q`M BAUFU3 literal 0 HcmV?d00001 diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index fd2fe78907..7371ba7009 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -101,7 +101,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv_const, & "Diffusivity used in convective regime. Corresponding viscosity "//& - "(KV_CONV) will be set to KD_CONV * PRANDTL_TURB.", & + "(KV_CONV) will be set to KD_CONV * PRANDTL_CONV.", & units='m2/s', default=1.00) call get_param(param_file, mdl, 'BV_SQR_CONV', CS%bv_sqr_conv, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 350f73d164..fb969953c4 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -911,7 +911,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) else ; L(K) = L(K)*pbv%por_layer_widthV(i,J,K); endif ! Determine the drag contributing to the bottom boundary layer - ! and the Raleigh drag that acts on each layer. + ! and the Rayleigh drag that acts on each layer. if (L(K) > L(K+1)) then if (vol_below < bbl_thick) then BBL_frac = (1.0-vol_below/bbl_thick)**2 diff --git a/src/parameterizations/vertical/_V_diffusivity.dox b/src/parameterizations/vertical/_V_diffusivity.dox index 8c4c8ce7aa..f3b7ed5962 100644 --- a/src/parameterizations/vertical/_V_diffusivity.dox +++ b/src/parameterizations/vertical/_V_diffusivity.dox @@ -278,7 +278,7 @@ The original version concentrates buoyancy work in regions of strong stratificat The shape of the \cite danabasoglu2012 background mixing has a uniform background value, with a dip at the equator and a bump at \f$\pm 30^{\circ}\f$ degrees latitude. The form is shown in this figure -\image html background_varying.png "Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator." +\image html background_varying.png "Form of the vertically uniform background mixing in Danabasoglu [2012]. The values are symmetric about the equator." \imagelatex{background_varying.png,Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} Some parameters of this curve are set in the input file, some are hard-coded in calculate_bkgnd_mixing. diff --git a/src/parameterizations/vertical/_V_viscosity.dox b/src/parameterizations/vertical/_V_viscosity.dox index cc59e83457..e40123386f 100644 --- a/src/parameterizations/vertical/_V_viscosity.dox +++ b/src/parameterizations/vertical/_V_viscosity.dox @@ -1,4 +1,19 @@ -/*! \page Vertical_Viscosity Viscous Bottom Boundary Layer +/*! \page Vertical_Viscosity Vertical Viscosity + +The vertical viscosity is composed of several components. + +-# The vertical diffusivity computations for the background and shear +mixing all save contributions to the viscosity with an assumed turbulent +Prandtl number of 1.0, though this can be changed with the PRANDTL_BKGND and +PRANDTL_TURB parameters, respectively. +-# If the ePBL scheme is used, it contributes to the vertical viscosity +with a Prandtl number of PRANDTL_EPBL. +-# If the CVMix scheme is used, it contributes to the vertical viscosity +with a Prandtl number of PRANDTL_CONV. +-# If the tidal mixing scheme is used, it contributes to the vertical +viscosity with a Prandtl number of PRANDTL_TIDAL. + +\section set_viscous_BBL Viscous Bottom Boundary Layer A drag law is used, either linearized about an assumed bottom velocity or using the actual near-bottom velocities combined with an assumed unresolved velocity. The bottom @@ -6,8 +21,6 @@ boundary layer thickness is limited by a combination of stratification and rotat in the paper of \cite killworth1999. It is not necessary to calculate the thickness and viscosity every time step; instead previous values may be used. -\section set_viscous_BBL Viscous Bottom Boundary Layer - If set_visc_CS\%bottomdraglaw is True then a bottom boundary layer viscosity and thickness are calculated so that the bottom stress is \f[ @@ -31,7 +44,7 @@ thin upwind cells helps increase the effect of viscosity and inhibits flow out o thin cells. After diagnosing \f$|U_{bbl}|\f$ over a fixed depth an active viscous boundary layer -thickness is found using the ideas of Killworth and Edwards, 1999 (hereafter KW99). +thickness is found using the ideas of \cite killworth1999 (hereafter KW99). KW99 solve the equation \f[ \left( \frac{h_{bbl}}{h_f} \right)^2 + \frac{h_{bbl}}{h_N} = 1 @@ -56,9 +69,54 @@ If a Richardson number dependent mixing scheme is being used, as indicated by set_visc_CS\%rino_mix, then the boundary layer thickness is bounded to be no larger than a half of set_visc_CS\%hbbl . -\todo Channel drag needs to be explained - A BBL viscosity is calculated so that the no-slip boundary condition in the vertical -viscosity solver implies the stress \f$\mathbf{\tau}_b\f$. +viscosity solver implies the stress \f$\mathbf{\tau}_b\f$: + +\f[ + K_{bbl} = \frac{1}{2} h_{bbl} \sqrt{C_{drag}} \, u^\ast +\f] + +\section section_Channel_drag Channel Drag + +The channel drag is an extra Rayleigh drag applied to those layers +within the bottom boundary layer. It is called channel drag because it +accounts for curvature of the bottom, applying the drag proportionally +to how much of each cell is within the bottom boundary layer. +The bottom shape is approximated as locally parabolic. The +bottom drag is applied to each layer with a factor \f$R_k\f$, the sum +of which is 1 over all the layers. + +\image html channel_drag.png "Example of layers intersecting a sloping bottom, with the blue showing the fraction of the cell over which bottom drag is applied." +\imagelatex{channel_drag.png,Example of layers intersecting a sloping bottom\, with the blue showing the fraction of the cell over which bottom drag is applied.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} + +The velocity that is actually subject to the bottom drag may be +substantially lower than the mean layer velocity, especially if only +a small fraction of the layer's width is subject to the bottom drag. + +The code begins by finding the arithmetic mean of the water depths to +find the depth at the velocity points. It then uses these to construct +a parabolic bottom shape, valid for \f$I - \frac{1}{2}\f$ to \f$I + +\frac{1}{2}\f$. The parabola is: + +\f[ + D(x) = a x^2 + b x + D - \frac{a}{12} +\f] + +For sufficiently small curvature \f$a\f$, one can drop the quadratic +term and assume a linear function instead. We want a form that matches +the traditional bottom drag when the bottom is flat. + +We defined the open fraction of each cell as \f$l(k) \equiv L(k)/L_{Tot}\f$, +where terms of order \f$l^2\f$ will be dropped. + +Hallberg (personal communication) shows how they came up with the form used in the code, in which the +\f$R_k\f$ above are set to: + +\f[ + R_k = \gamma_k l_{k-1/2} \left[ \frac{12 c_{Smag} h_k}{12 c_{Smag} k_k + c_d \gamma_k (1 - \gamma_k) + (1 - \frac{3}{2} \gamma_k) l^2_{k-1/2} L_{Tot}} \right] +\f] +with the definition \f$\gamma_k \equiv (l_{k-1/2} - l_{k+1/2})/l_{k-1/2}\f$. This ensures that \f$\sum^N_{k=1} +\gamma_k l_{k-1/2} = 1\f$ since \f$l_{1/2} = 1\f$ and \f$l_{N+1/2} = 0\f$. */ From 3f58f8a3abe355fa818d4f5d888f3c13c95a6070 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 3 Feb 2022 00:24:17 -0500 Subject: [PATCH 137/138] read_variable_2d modified to accept 3 or 4 dims The read_variable_2d function was previously configured to only run if the start and nread arrays matched the size of the field they were accessing. This was incompatible with the history of the function, which had previously required a fourth time axis (of one record), then was later modified to not require this axis. As a result, there are now files in use both with and without a time axis. This patch relaxes this check to ensure that the read is quasi-2d, i.e. the first two axes can read a segment of a 2d field, but will now reshape the start and nread arrays to match the field being read. Some additional checks are also added to ensure that it only reads one 2d slice. --- src/framework/MOM_io.F90 | 107 ++++++++++++++++++++++++++++++++------- 1 file changed, 89 insertions(+), 18 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 2ea19df183..8928d2e56b 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -892,9 +892,17 @@ end subroutine read_variable_1d_int !> Read a 2d array from a netCDF input file and save to a variable. !! -!! Start and nread ranks may exceed var, but must match the rank of the -!! variable in the netCDF file. This allows for reading slices of larger -!! arrays. +!! Start and nread lenths may exceed var rank. This allows for reading slices +!! of larger arrays. +!! +!! Previous versions of the model required a time axis on IO fields. This +!! constraint was dropped in later versions. As a result, versions both with +!! and without a time axis now exist. In order to support all such versions, +!! we use a reshaped version of start and nread in order to read the variable +!! as it exists in the file. +!! +!! Certain constraints are still applied to start and nread in order to ensure +!! that varname is a valid 2d array, or contains valid 2d slices. !! !! I/O occurs only on the root PE, and data is broadcast to other ranks. !! Due to potentially large memory communication and storage, this subroutine @@ -908,11 +916,40 @@ subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. !! If absent, the file is opened and closed within this routine. - integer :: ncid, varid, ndims, rc - character(len=*), parameter :: hdr = "read_variable_2d" + integer :: ncid, varid + integer :: field_ndims, dim_len + integer, allocatable :: field_dimids(:), field_shape(:) + integer, allocatable :: field_start(:), field_nread(:) + integer :: i, rc + character(len=*), parameter :: hdr = "read_variable_2d: " character(len=128) :: msg - logical :: size_mismatch + ! Validate shape of start and nread + if (present(start)) then + if (size(start) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start must have at least two dimensions.") + endif + + if (present(nread)) then + if (size(nread) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread must have at least two dimensions.") + + if (any(nread(3:) > 1)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread may only read a single level in higher dimensions.") + endif + + ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure + ! that their lengths are equivalent, and must do it here. + if (present(start) .and. present(nread)) then + if (size(start) /= size(nread)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start and nread must have the same length.") + endif + + ! Open and read `varname` from `filename` if (is_root_pe()) then if (present(ncid_in)) then ncid = ncid_in @@ -923,23 +960,57 @@ subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) call get_varid(varname, ncid, filename, varid, match_case=.false.) if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//& " in "//trim(filename)) - ! Verify that start(:) and nread(:) ranks match variable's dimension count - rc = nf90_inquire_variable(ncid, varid, ndims=ndims) + + ! Query for the dimensionality of the input field + rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims) if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& - " Difficulties reading "//trim(varname)//" from "//trim(filename)) + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + ! Confirm that field is at least 2d + if (field_ndims < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) // " " // & + trim(varname) // " from " // trim(filename) // " is not a 2D field.") + + ! If start and nread are present, then reshape them to match field dims + if (present(start) .or. present(nread)) then + allocate(field_shape(field_ndims)) + allocate(field_dimids(field_ndims)) + + rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + do i = 1, field_ndims + rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // ": Difficulties reading dimensions from " // trim(filename)) + field_shape(i) = dim_len + enddo - size_mismatch = .false. - if (present(start)) size_mismatch = size_mismatch .or. size(start) /= ndims - if (present(nread)) size_mismatch = size_mismatch .or. size(nread) /= ndims + ! Reshape start(:) and nreads(:) in case ranks differ + allocate(field_start(field_ndims)) + field_start(:) = 1 + if (present(start)) then + dim_len = min(size(start), size(field_start)) + field_start(:dim_len) = start(:dim_len) + endif + + allocate(field_nread(field_ndims)) + field_nread(:2) = field_shape(:2) + field_nread(3:) = 1 + if (present(nread)) field_shape(:2) = nread(:2) - if (size_mismatch) then - write (msg, '("'// hdr //': size(start) ", i0, " and/or size(nread) ", & - i0, " do not match ndims ", i0)') size(start), size(nread), ndims - call MOM_error(FATAL, trim(msg)) + rc = nf90_get_var(ncid, varid, var, field_start, field_nread) + + deallocate(field_start) + deallocate(field_nread) + deallocate(field_shape) + deallocate(field_dimids) + else + rc = nf90_get_var(ncid, varid, var) endif - ! NOTE: We could check additional information here (type, size, ...) - rc = nf90_get_var(ncid, varid, var, start, nread) if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& " Difficulties reading "//trim(varname)//" from "//trim(filename)) From 64f432fcb5b962a890330788fc11c80572296fd1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 15 Feb 2022 22:10:51 -0500 Subject: [PATCH 138/138] Diabatic driver: energetic_PBL -> ePBL, flag check Pointers to the diabatic driver's energetic PBL field are now only associated when `use_energetic_PBL` is true. The `energetic_PBL` field was also renamed to `ePBL` to avoid potential conflict with the `energetic_PBL` subroutine. Thanks to Alper Altuntas for detecting this issue and the proposed fix. Co-Authored-By: Alper Altuntas --- .../vertical/MOM_diabatic_driver.F90 | 21 +++++++++---------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 5eaca3c275..7b180f1d65 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -234,7 +234,7 @@ module MOM_diabatic_driver type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control struct - type(energetic_PBL_CS) :: energetic_PBL !< Energetic PBL control struct + type(energetic_PBL_CS) :: ePBL !< Energetic PBL control struct type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(geothermal_CS) :: geothermal !< Geothermal control struct type(int_tide_CS) :: int_tide !< Internal tide control struct @@ -838,15 +838,15 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -1375,15 +1375,15 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -2589,14 +2589,13 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(opacity_CSp)) opacity_CSp => CS%opacity if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp - if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL + if (present(energetic_PBL_CSp) .and. CS%use_energetic_PBL) energetic_PBL_CSp => CS%ePBL if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth if (present(diabatic_halo)) diabatic_halo = CS%halo_TS_diff - end subroutine extract_diabatic_member !> Routine called for adiabatic physics @@ -3487,7 +3486,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_bulkmixedlayer) & call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer) if (CS%use_energetic_PBL) & - call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL) + call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%ePBL) call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers) @@ -3522,7 +3521,7 @@ subroutine diabatic_driver_end(CS) call diapyc_energy_req_end(CS%diapyc_en_rec_CSp) if (CS%use_energetic_PBL) & - call energetic_PBL_end(CS%energetic_PBL) + call energetic_PBL_end(CS%ePBL) call diabatic_aux_end(CS%diabatic_aux_CSp)