From ffbdab9f1a66f8b3fc4af61260c8a1f6705afd35 Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Tue, 15 May 2018 16:21:29 -0400 Subject: [PATCH 001/106] Updating MOM6 --- .../MOM_state_initialization.F90 | 4 + src/tracer/Elizabeth_tracer.F90 | 384 ++++++++++++++++++ src/tracer/MOM_tracer_flow_control.F90 | 15 + src/user/Elizabeth_initialization.F90 | 256 ++++++++++++ 4 files changed, 659 insertions(+) create mode 100644 src/tracer/Elizabeth_tracer.F90 create mode 100644 src/user/Elizabeth_initialization.F90 diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 858713002b..d553543297 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -52,6 +52,7 @@ module MOM_state_initialization use ISOMIP_initialization, only : ISOMIP_initialize_thickness use ISOMIP_initialization, only : ISOMIP_initialize_sponges use ISOMIP_initialization, only : ISOMIP_initialize_temperature_salinity +use Elizabeth_initialization, only : Elizabeth_initialize_sponges use baroclinic_zone_initialization, only : baroclinic_zone_init_temperature_salinity use benchmark_initialization, only : benchmark_initialize_thickness use benchmark_initialization, only : benchmark_init_temperature_salinity @@ -509,6 +510,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t file - read sponge properties from the file \n"//& " \t\t specified by (SPONGE_FILE).\n"//& " \t ISOMIP - apply ale sponge in the ISOMIP case \n"//& + " \t Elizabeth - apply sponge in the Elizabeth case \n"//& " \t DOME - use a slope and channel configuration for the \n"//& " \t\t DOME sill-overflow test case. \n"//& " \t BFB - Sponge at the southern boundary of the domain\n"//& @@ -520,6 +522,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) + case("Elizabeth"); call Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, useALE, & + sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, use_temperature, tv, & PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, use_temperature, tv, & diff --git a/src/tracer/Elizabeth_tracer.F90 b/src/tracer/Elizabeth_tracer.F90 new file mode 100644 index 0000000000..9bf70a24c3 --- /dev/null +++ b/src/tracer/Elizabeth_tracer.F90 @@ -0,0 +1,384 @@ +!> This module contains the routines used to set up and use a set of (one for now) +!! dynamically passive tracers. For now, three passive tracers can be injected in +!! the domain +!! Set up and use passive tracers requires the following: +!! (1) register_Elizabeth_tracer +!! (2) apply diffusion, physics/chemistry and advect the tracer + +!********+*********+*********+*********+*********+*********+*********+** +!* * +!* By Robert Hallberg, 2002 * +!* Adapted to the IDEAL_IS test case by Gustavo Marques, Oct 2016 * +!*********+*********+*********+*********+*********+*********+*********** + +module Elizabeth_tracer + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : diag_ctrl +use MOM_diag_to_Z, only : register_Z_tracer, diag_to_Z_CS +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_hor_index, only : hor_index_type +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc +use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type, get_time +use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values +use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut +use MOM_variables, only : surface +use MOM_open_boundary, only : ocean_OBC_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_coms, only : max_across_PEs, min_across_PEs + +implicit none ; private + +#include + +!< Publicly available functions +public register_Elizabeth_tracer, initialize_Elizabeth_tracer +public Elizabeth_tracer_column_physics, Elizabeth_tracer_end + +!< ntr is the number of tracers in this module. (originally 2) +integer, parameter :: NTR = 1 + +type p3d + real, dimension(:,:,:), pointer :: p => NULL() +end type p3d + +!> tracer control structure +type, public :: Elizabeth_tracer_CS ; private + logical :: coupled_tracers = .false. !< These tracers are not offered to the + !< coupler. + character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " " + !< to initialize internally. + type(time_type), pointer :: Time !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this + !< subroutine, in g m-3? + real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration + !< for output, in g m-3. + type(p3d), dimension(NTR) :: & + tr_adx, &!< Tracer zonal advective fluxes in g m-3 m3 s-1. + tr_ady, &!< Tracer meridional advective fluxes in g m-3 m3 s-1. + tr_dfx, &!< Tracer zonal diffusive fluxes in g m-3 m3 s-1. + tr_dfy !< Tracer meridional diffusive fluxes in g m-3 m3 s-1. + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. + real :: lenlat ! the latitudinal or y-direction length of the domain. + real :: lenlon ! the longitudinal or x-direction length of the domain. + real :: CSL ! The length of the continental shelf (x dir, km) + real :: lensponge ! the length of the sponge layer. + logical :: mask_tracers !< If true, tracers are masked out in massless layers. + logical :: use_sponge + + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !< timing of diagnostic output. + integer, dimension(NTR) :: id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1 + integer, dimension(NTR) :: id_tr_dfx = -1, id_tr_dfy = -1 + + type(vardesc) :: tr_desc(NTR) +end type Elizabeth_tracer_CS + +contains + + +!> This subroutine is used to register tracer fields +function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, & + restart_CS) + type(hor_index_type), intent(in) :: HI ! NULL() + logical :: register_Elizabeth_tracer + integer :: isd, ied, jsd, jed, nz, m + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + + if (associated(CS)) then + call MOM_error(WARNING, "Elizabeth_register_tracer called with an "// & + "associated control structure.") + return + endif + allocate(CS) + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "Elizabeth_TRACER_IC_FILE", CS%tracer_IC_file, & + "The name of a file from which to read the initial \n"//& + "conditions for the Elizabeth tracers, or blank to initialize \n"//& + "them internally.", default=" ") + if (len_trim(CS%tracer_IC_file) >= 1) then + call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + CS%tracer_IC_file = trim(inputdir)//trim(CS%tracer_IC_file) + call log_param(param_file, mod, "INPUTDIR/Elizabeth_TRACER_IC_FILE", & + CS%tracer_IC_file) + endif + call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + "If true, sponges may be applied anywhere in the domain. \n"//& + "The exact location and properties of those sponges are \n"//& + "specified from MOM_initialization.F90.", default=.false.) + + call get_param(param_file, mod, "LENLAT", CS%lenlat, & + "The latitudinal or y-direction length of the domain", & + fail_if_missing=.true., do_not_log=.true.) + + call get_param(param_file, mod, "LENLON", CS%lenlon, & + "The longitudinal or x-direction length of the domain", & + fail_if_missing=.true., do_not_log=.true.) + + call get_param(param_file, mod, "CONT_SHELF_LENGTH", CS%CSL, & + "The length of the continental shelf (x dir, km).", & + default=15.0) + + call get_param(param_file, mod, "LENSPONGE", CS%lensponge, & + "The length of the sponge layer (km).", & + default=10.0) + + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + if (CS%mask_tracers) then + allocate(CS%tr_aux(isd:ied,jsd:jed,nz,NTR)) ; CS%tr_aux(:,:,:,:) = 0.0 + endif + + do m=1,NTR + if (m < 10) then ; write(name,'("tr_D",I1.1)') m + else ; write(name,'("tr_D",I2.2)') m ; endif + write(longname,'("Concentration of Elizabeth Tracer ",I2.2)') m + CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mod) + + ! This is needed to force the compiler not to do a copy in the registration + ! calls. Curses on the designers and implementers of Fortran90. + tr_ptr => CS%tr(:,:,:,m) + ! Register the tracer for the restart file. + call register_restart_field(tr_ptr, CS%tr_desc(m), .true., restart_CS) + ! Register the tracer for horizontal advection & diffusion. + call register_tracer(tr_ptr, CS%tr_desc(m), param_file, HI, GV, tr_Reg, & + tr_desc_ptr=CS%tr_desc(m)) + + enddo + + CS%tr_Reg => tr_Reg + register_Elizabeth_tracer = .true. +end function register_Elizabeth_tracer + +!> Initializes the NTR tracer fields in tr(:,:,:,:) +! and it sets up the tracer output. +subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & + sponge_CSp, diag_to_Z_CSp) + + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: restart !< .true. if the fields have already been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(diag_ctrl), target, intent(in) :: diag + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. + type(Elizabeth_tracer_CS), pointer :: CS !< The control structure returned by a previous call to Elizabeth_register_tracer. + 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. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure for diagnostics in depth space. + + real, allocatable :: temp(:,:,:) + real, pointer, dimension(:,:,:) :: & + OBC_tr1_u => NULL(), & ! These arrays should be allocated and set to + OBC_tr1_v => NULL() ! specify the values of tracer 1 that should come + ! in through u- and v- points through the open + ! boundary conditions, in the same units as tr. + 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 tracer fluxes, usually + ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. + 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, in m2. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected, in m. + real :: e(SZK_(G)+1), e_top, e_bot, d_tr + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m + integer :: IsdB, IedB, JsdB, JedB + + if (.not.associated(CS)) return + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + h_neglect = GV%H_subroundoff + + CS%Time => day + CS%diag => diag + + if (.not.restart) then + if (len_trim(CS%tracer_IC_file) >= 1) then + ! Read the tracer concentrations from a netcdf file. + if (.not.file_exists(CS%tracer_IC_file, G%Domain)) & + call MOM_error(FATAL, "Elizabeth_initialize_tracer: Unable to open "// & + CS%tracer_IC_file) + do m=1,NTR + call query_vardesc(CS%tr_desc(m), name, caller="initialize_Elizabeth_tracer") + call read_data(CS%tracer_IC_file, trim(name), & + CS%tr(:,:,:,m), domain=G%Domain%mpp_domain) + enddo + else + do m=1,NTR + do k=1,nz ; do j=js,je ; do i=is,ie + CS%tr(i,j,k,m) = 0.0 + enddo ; enddo ; enddo + enddo + endif + endif ! restart + + ! This needs to be changed if the units of tracer are changed above. + if (GV%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1" + else ; flux_units = "kg s-1" ; endif + + do m=1,NTR + ! Register the tracer for the restart file. + call query_vardesc(CS%tr_desc(m), name, units=units, longname=longname, & + caller="initialize_Elizabeth_tracer") + CS%id_tracer(m) = register_diag_field("ocean_model", trim(name), CS%diag%axesTL, & + day, trim(longname) , trim(units)) + CS%id_tr_adx(m) = register_diag_field("ocean_model", trim(name)//"_adx", & + CS%diag%axesCuL, day, trim(longname)//" advective zonal flux" , & + trim(flux_units)) + CS%id_tr_ady(m) = register_diag_field("ocean_model", trim(name)//"_ady", & + CS%diag%axesCvL, day, trim(longname)//" advective meridional flux" , & + trim(flux_units)) + CS%id_tr_dfx(m) = register_diag_field("ocean_model", trim(name)//"_dfx", & + CS%diag%axesCuL, day, trim(longname)//" diffusive zonal flux" , & + trim(flux_units)) + CS%id_tr_dfy(m) = register_diag_field("ocean_model", trim(name)//"_dfy", & + CS%diag%axesCvL, day, trim(longname)//" diffusive zonal flux" , & + trim(flux_units)) + if (CS%id_tr_adx(m) > 0) call safe_alloc_ptr(CS%tr_adx(m)%p,IsdB,IedB,jsd,jed,nz) + if (CS%id_tr_ady(m) > 0) call safe_alloc_ptr(CS%tr_ady(m)%p,isd,ied,JsdB,JedB,nz) + if (CS%id_tr_dfx(m) > 0) call safe_alloc_ptr(CS%tr_dfx(m)%p,IsdB,IedB,jsd,jed,nz) + if (CS%id_tr_dfy(m) > 0) call safe_alloc_ptr(CS%tr_dfy(m)%p,isd,ied,JsdB,JedB,nz) + +! Register the tracer for horizontal advection & diffusion. + if ((CS%id_tr_adx(m) > 0) .or. (CS%id_tr_ady(m) > 0) .or. & + (CS%id_tr_dfx(m) > 0) .or. (CS%id_tr_dfy(m) > 0)) & + call add_tracer_diagnostics(name, CS%tr_Reg, CS%tr_adx(m)%p, & + CS%tr_ady(m)%p, CS%tr_dfx(m)%p, CS%tr_dfy(m)%p) + + call register_Z_tracer(CS%tr(:,:,:,m), trim(name), longname, units, & + day, G, diag_to_Z_CSp) + enddo + +end subroutine initialize_Elizabeth_tracer + +!> This subroutine applies diapycnal diffusion and any other column +! tracer physics or chemistry to the tracers from this file. +! This is a simple example of a set of advected passive tracers. +subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, dt, G, GV, CS) + type(ocean_grid_type), intent(in) :: G + type(verticalGrid_type), intent(in) :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb + real, intent(in) :: dt + type(Elizabeth_tracer_CS), pointer :: CS + +! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. +! (in) h_new - Layer thickness after entrainment, in m or kg m-2. +! (in) ea - an array to which the amount of fluid entrained +! from the layer above during this call will be +! added, in m or kg m-2. +! (in) eb - an array to which the amount of fluid entrained +! from the layer below during this call will be +! added, in m or kg m-2. +! (in) dt - The amount of time covered by this call, in s. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) CS - The control structure returned by a previous call to +! Elizabeth_register_tracer. +! +! The arguments to this subroutine are redundant in that +! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + + real :: mmax, area + real :: b1(SZI_(G)) ! b1 and c1 are variables used by the + real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + integer :: i, j, k, is, ie, js, je, nz, m + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + if (.not.associated(CS)) return + + m=1 + do j=js,je ; do i=is,ie + ! Set tracer to 1.0 in the surface of the continental shelf + if (G%geoLonT(i,j) <= (CS%CSL) then + CS%tr(i,j,1,m) = 1.0 ! first layer + endif + + enddo ; enddo + + do j=js,je ; do i=is,ie + ! remove tracer in the sponge layer + if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + CS%tr(i,j,:,m) = 0.0 ! all layers + endif + + enddo ; enddo + + if (CS%mask_tracers) then + do m = 1,NTR ; if (CS%id_tracer(m) > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + if (h_new(i,j,k) < 1.1*GV%Angstrom) then + CS%tr_aux(i,j,k,m) = CS%land_val(m) + else + CS%tr_aux(i,j,k,m) = CS%tr(i,j,k,m) + endif + enddo ; enddo ; enddo + endif ; enddo + endif + + do m=1,NTR + if (CS%mask_tracers) then + if (CS%id_tracer(m)>0) & + call post_data(CS%id_tracer(m),CS%tr_aux(:,:,:,m),CS%diag) + else + if (CS%id_tracer(m)>0) & + call post_data(CS%id_tracer(m),CS%tr(:,:,:,m),CS%diag) + endif + if (CS%id_tr_adx(m)>0) & + call post_data(CS%id_tr_adx(m),CS%tr_adx(m)%p(:,:,:),CS%diag) + if (CS%id_tr_ady(m)>0) & + call post_data(CS%id_tr_ady(m),CS%tr_ady(m)%p(:,:,:),CS%diag) + if (CS%id_tr_dfx(m)>0) & + call post_data(CS%id_tr_dfx(m),CS%tr_dfx(m)%p(:,:,:),CS%diag) + if (CS%id_tr_dfy(m)>0) & + call post_data(CS%id_tr_dfy(m),CS%tr_dfy(m)%p(:,:,:),CS%diag) + enddo + +end subroutine Elizabeth_tracer_column_physics + +subroutine Elizabeth_tracer_end(CS) + type(Elizabeth_tracer_CS), pointer :: CS + integer :: m + + if (associated(CS)) then + if (associated(CS%tr)) deallocate(CS%tr) + if (associated(CS%tr_aux)) deallocate(CS%tr_aux) + do m=1,NTR + if (associated(CS%tr_adx(m)%p)) deallocate(CS%tr_adx(m)%p) + if (associated(CS%tr_ady(m)%p)) deallocate(CS%tr_ady(m)%p) + if (associated(CS%tr_dfx(m)%p)) deallocate(CS%tr_dfx(m)%p) + if (associated(CS%tr_dfy(m)%p)) deallocate(CS%tr_dfy(m)%p) + enddo + + deallocate(CS) + endif +end subroutine Elizabeth_tracer_end + +end module Elizabeth_tracer diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 0a11de9c1e..6109fc4ddd 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -29,6 +29,9 @@ module MOM_tracer_flow_control use ISOMIP_tracer, only : register_ISOMIP_tracer, initialize_ISOMIP_tracer use ISOMIP_tracer, only : ISOMIP_tracer_column_physics, ISOMIP_tracer_surface_state use ISOMIP_tracer, only : ISOMIP_tracer_end, ISOMIP_tracer_CS +use Elizabeth_tracer, only : register_Elizabeth_tracer, initialize_Elizabeth_tracer +use Elizabeth_tracer, only : Elizabeth_tracer_column_physics +use Elizabeth_tracer, only : Elizabeth_tracer_end, Elizabeth_tracer_CS use ideal_age_example, only : register_ideal_age_tracer, initialize_ideal_age_tracer use ideal_age_example, only : ideal_age_tracer_column_physics, ideal_age_tracer_surface_state use ideal_age_example, only : ideal_age_stock, ideal_age_example_end, ideal_age_tracer_CS @@ -71,6 +74,7 @@ module MOM_tracer_flow_control logical :: use_USER_tracer_example = .false. logical :: use_DOME_tracer = .false. logical :: use_ISOMIP_tracer = .false. + logical :: use_Elizabeth_tracer =.false. logical :: use_ideal_age = .false. logical :: use_regional_dyes = .false. logical :: use_oil = .false. @@ -83,6 +87,7 @@ module MOM_tracer_flow_control type(USER_tracer_example_CS), pointer :: USER_tracer_example_CSp => NULL() type(DOME_tracer_CS), pointer :: DOME_tracer_CSp => NULL() type(ISOMIP_tracer_CS), pointer :: ISOMIP_tracer_CSp => NULL() + type(Elizabeth_tracer_CS), pointer :: Elizabeth_tracer_CSp => NULL() type(ideal_age_tracer_CS), pointer :: ideal_age_tracer_CSp => NULL() type(dye_tracer_CS), pointer :: dye_tracer_CSp => NULL() type(oil_tracer_CS), pointer :: oil_tracer_CSp => NULL() @@ -181,6 +186,9 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "USE_ISOMIP_TRACER", CS%use_ISOMIP_tracer, & "If true, use the ISOMIP_tracer tracer package.", & default=.false.) + call get_param(param_file, mdl, "USE_ELIZABETH_TRACER", CS%use_Elizabeth_tracer, & + "If true, use the Elizabeth_tracer tracer package.", & + default=.false.) call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", CS%use_ideal_age, & "If true, use the ideal_age_example tracer package.", & default=.false.) @@ -229,6 +237,9 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) if (CS%use_ISOMIP_tracer) CS%use_ISOMIP_tracer = & register_ISOMIP_tracer(HI, GV, param_file, CS%ISOMIP_tracer_CSp, & tr_Reg, restart_CS) + if (CS%use_Elizabeth_tracer) CS%use_Elizabeth_tracer = & + register_Elizabeth_tracer(HI, GV, param_file, CS%Elizabeth_tracer_CSp & + tr_Reg, restart_CS) if (CS%use_ideal_age) CS%use_ideal_age = & register_ideal_age_tracer(HI, GV, param_file, CS%ideal_age_tracer_CSp, & tr_Reg, restart_CS) @@ -309,6 +320,9 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB if (CS%use_ISOMIP_tracer) & call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, & ALE_sponge_CSp, diag_to_Z_CSp) + if (CS%use_Elizabeth_tracer) & + call initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, & + CS%Elizabeth_tracer_CSp, sponge_CSp, diag_to_Z_CSp) if (CS%use_ideal_age) & call initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS%ideal_age_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) @@ -836,6 +850,7 @@ subroutine tracer_flow_control_end(CS) call USER_tracer_example_end(CS%USER_tracer_example_CSp) if (CS%use_DOME_tracer) call DOME_tracer_end(CS%DOME_tracer_CSp) if (CS%use_ISOMIP_tracer) call ISOMIP_tracer_end(CS%ISOMIP_tracer_CSp) + if (CS%use_Elizabeth_tracer) call Elizabeth_tracer_end(CS%Elizabeth_tracer_CSp) if (CS%use_ideal_age) call ideal_age_example_end(CS%ideal_age_tracer_CSp) if (CS%use_regional_dyes) call regional_dyes_end(CS%dye_tracer_CSp) if (CS%use_oil) call oil_tracer_end(CS%oil_tracer_CSp) diff --git a/src/user/Elizabeth_initialization.F90 b/src/user/Elizabeth_initialization.F90 new file mode 100644 index 0000000000..1d7a0f47fa --- /dev/null +++ b/src/user/Elizabeth_initialization.F90 @@ -0,0 +1,256 @@ +module Elizabeth_initialization +!*********************************************************************** +!* GNU General Public License * +!* This file is a part of MOM. * +!* * +!* MOM is free software; you can redistribute it and/or modify it and * +!* are expected to follow the terms of the GNU General Public License * +!* as published by the Free Software Foundation; either version 2 of * +!* the License, or (at your option) any later version. * +!* * +!* MOM is distributed in the hope that it will be useful, but WITHOUT * +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * +!* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public * +!* License for more details. * +!* * +!* For the full text of the GNU General Public License, * +!* write to: Free Software Foundation, Inc., * +!* 675 Mass Ave, Cambridge, MA 02139, USA. * +!* or see: http://www.gnu.org/licenses/gpl.html * +!*********************************************************************** + +use MOM_ALE_sponge, only : ALE_sponge_CS, set_up_ALE_sponge_field, initialize_ALE_sponge +use MOM_ALE_sponge, only : set_up_ALE_sponge_vel_field +use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge +use MOM_sponge, only : set_up_sponge_ML_density +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe, WARNING +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : close_file, fieldtype, file_exists +use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE +use MOM_io, only : write_field, slasher, vardesc +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type +use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE +use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR +use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA +implicit none ; private + +#include + +! ----------------------------------------------------------------------------- +! Private (module-wise) parameters +! ----------------------------------------------------------------------------- + +character(len=40) :: mod = "Elizabeth_initialization" ! This module's name. + +! ----------------------------------------------------------------------------- +! The following routines are visible to the outside world +! ----------------------------------------------------------------------------- +public Elizabeth_initialize_sponges + +! ----------------------------------------------------------------------------- +! This module contains the following routines +! ----------------------------------------------------------------------------- +contains + +!> Sets up the 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. +subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers + !! to any available thermodynamic + !! fields, potential temperature and + !! salinity or mixed layer density. + !! Absent fields have NULL ptrs. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v + type(param_file_type), intent(in) :: PF !< A structure indicating the + !! open file to parse for model + !! parameter values. + logical, intent(in) :: use_ALE !< If true, indicates model is in ALE mode + type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure + type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure + +! Local variables + real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp + real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt + real :: U1(SZIB_(G), SZJ_(G), SZK_(G)) ! A temporary array for u + real :: V1(SZI_(G), SZJB_(G), SZK_(G)) ! A temporary array for v + real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO + real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. + real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness at h points + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points, in s-1. + real :: TNUDG ! Nudging time scale, days + real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa + + real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! + ! negative because it is positive upward. ! + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. + + ! positive upward, in m. + logical :: sponge_uv ! Nudge velocities (u and v) towards zero + real :: min_depth, dummy1, z, delta_h + real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 + real :: lenlat, lenlon, lensponge + character(len=40) :: filename, state_file + character(len=40) :: temp_var, salt_var, eta_var, inputdir, h_var + + character(len=40) :: mod = "Elizabeth_initialize_sponges" ! This subroutine's name. + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, iscB, iecB, jscB, jecB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + iscB = G%iscB ; iecB = G%iecB; jscB = G%jscB ; jecB = G%jecB + + call get_param(PF,mod,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) + + call get_param(PF, mod, "IDEAL_IS_TNUDG", TNUDG, 'Nudging time scale for sponge layers (days)', default=0.0) + + call get_param(PF, mod, "LENLAT", lenlat, & + "The latitudinal or y-direction length of the domain", & + fail_if_missing=.true., do_not_log=.true.) + + call get_param(PF, mod, "LENLON", lenlon, & + "The longitudinal or x-direction length of the domain", & + fail_if_missing=.true., do_not_log=.true.) + + call get_param(PF, mod, "LENSPONGE", lensponge, & + "The length of the sponge layer (km).", & + default=10.0) + + call get_param(PF, mod, "SPONGE_UV", sponge_uv, & + "Nudge velocities (u and v) towards zero in the sponge layer.", & + default=.false., do_not_log=.true.) + + T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0 + + call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + if (associated(CSp)) call MOM_error(FATAL, & + "Elizabeth_initialize_sponges called with an associated control structure.") + if (associated(ACSp)) call MOM_error(FATAL, & + "Elizabeth_initialize_sponges called with an associated ALE-sponge control structure.") + + ! Here the inverse damping time, in 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. + + do i=is,ie; do j=js,je + if (G%geoLonT(i,j) <= lensponge) then + dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 + !damp = 1.0/TNUDG * max(0.0,dummy1) + damp = 0.0 + !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp + + elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then + + ! 1 / day + dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) + damp = (1.0/TNUDG) * max(0.0,dummy1) + + else ; damp=0.0 + endif + + ! convert to 1 / seconds + if (G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif + enddo ; enddo + + + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + ! GM: get two different files, one with temp and one with salt values + ! this is work around to avoid having wrong values near the surface + ! because of the FIT_SALINITY option. To get salt values right in the + ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can + ! combined the *correct* temp and salt values in one file instead. + call get_param(PF, mod, "IDEAL_IS_SPONGE_FILE", state_file, & + "The name of the file with temps., salts. and interfaces to \n"// & + " damp toward.", fail_if_missing=.true.) + call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & + "The name of the potential temperature variable in \n"//& + "SPONGE_STATE_FILE.", default="Temp") + call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & + "The name of the salinity variable in \n"//& + "SPONGE_STATE_FILE.", default="Salt") + call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & + "The name of the interface height variable in \n"//& + "SPONGE_STATE_FILE.", default="eta") + call get_param(PF, mod, "SPONGE_H_VAR", h_var, & + "The name of the layer thickness variable in \n"//& + "SPONGE_STATE_FILE.", default="h") + + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " Elizabeth_initialize_sponges: Unable to open "//trim(filename)) + call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) + call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) + + if (use_ALE) then + + call read_data(filename,h_var,h(:,:,:), domain=G%Domain%mpp_domain) + + !call initialize_ALE_sponge(Idamp, h, nz, G, PF, ACSp) + call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz) + + ! The remaining calls to set_up_sponge_field can be in any order. ! + if ( associated(tv%T) ) then + call set_up_ALE_sponge_field(T,G,tv%T,ACSp) + endif + if ( associated(tv%S) ) then + call set_up_ALE_sponge_field(S,G,tv%S,ACSp) + endif + + if (sponge_uv) then + U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 + call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) + + endif + + else ! layer mode + + !read eta + call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) + + ! Set the inverse 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) + + if ( GV%nkml>0 ) then + ! This call to set_up_sponge_ML_density registers the target values of the + ! mixed layer density, which is used in determining which layers can be + ! inflated without causing static instabilities. + do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo + + do j=js,je + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo + + call set_up_sponge_ML_density(tmp, G, CSp) + endif + + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) + + endif + +end subroutine Elizabeth_initialize_sponges + +!> \class Elizabeth_initialization +!! +!! The module configures the ISOMIP test case. +end module Elizabeth_initialization From 8fb772deb51703323614bf56d5173c5951093920 Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Tue, 15 May 2018 16:24:28 -0400 Subject: [PATCH 002/106] Updating pkg --- pkg/MOM6_DA_hooks | 1 + pkg/geoKdTree | 1 + 2 files changed, 2 insertions(+) create mode 160000 pkg/MOM6_DA_hooks create mode 160000 pkg/geoKdTree diff --git a/pkg/MOM6_DA_hooks b/pkg/MOM6_DA_hooks new file mode 160000 index 0000000000..6d8834ca8c --- /dev/null +++ b/pkg/MOM6_DA_hooks @@ -0,0 +1 @@ +Subproject commit 6d8834ca8cf399f1a0d202239d72919907f6cd74 diff --git a/pkg/geoKdTree b/pkg/geoKdTree new file mode 160000 index 0000000000..a4670b9743 --- /dev/null +++ b/pkg/geoKdTree @@ -0,0 +1 @@ +Subproject commit a4670b9743c883d310d821eeac5b1f77f587b9d5 From ac4d5e71ba66ab712c99fd07ee387ded1e53034a Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Wed, 30 May 2018 12:33:58 -0400 Subject: [PATCH 003/106] Adding the passive tracer --- src/tracer/Elizabeth_tracer.F90 | 134 +++++++++++++++---------- src/tracer/MOM_tracer_flow_control.F90 | 10 +- 2 files changed, 91 insertions(+), 53 deletions(-) diff --git a/src/tracer/Elizabeth_tracer.F90 b/src/tracer/Elizabeth_tracer.F90 index 9bf70a24c3..273defb3c5 100644 --- a/src/tracer/Elizabeth_tracer.F90 +++ b/src/tracer/Elizabeth_tracer.F90 @@ -8,7 +8,8 @@ !********+*********+*********+*********+*********+*********+*********+** !* * !* By Robert Hallberg, 2002 * -!* Adapted to the IDEAL_IS test case by Gustavo Marques, Oct 2016 * +!* Adapted to the IDEAL_IS test case by Gustavo Marques, Oct 2016 +!* Edited by Elizabeth Yankovsky, May 2018 * !*********+*********+*********+*********+*********+*********+*********** module Elizabeth_tracer @@ -20,6 +21,7 @@ module Elizabeth_tracer use MOM_diag_to_Z, only : register_Z_tracer, diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing use MOM_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc @@ -27,8 +29,8 @@ module Elizabeth_tracer use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time -use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values +use MOM_tracer_registry, only : register_tracer, tracer_registry_type +!use MOM_tracer_registry, only : add_tracer_diagnostics use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface use MOM_open_boundary, only : ocean_OBC_type @@ -43,7 +45,7 @@ module Elizabeth_tracer public register_Elizabeth_tracer, initialize_Elizabeth_tracer public Elizabeth_tracer_column_physics, Elizabeth_tracer_end -!< ntr is the number of tracers in this module. (originally 2) +!< ntr is the number of tracers in this module. integer, parameter :: NTR = 1 type p3d @@ -87,19 +89,18 @@ module Elizabeth_tracer !> This subroutine is used to register tracer fields -function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, & - restart_CS) - type(hor_index_type), intent(in) :: HI ! NULL() logical :: register_Elizabeth_tracer @@ -114,36 +115,36 @@ function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, & allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "Elizabeth_TRACER_IC_FILE", CS%tracer_IC_file, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "Elizabeth_TRACER_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial \n"//& "conditions for the Elizabeth tracers, or blank to initialize \n"//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) CS%tracer_IC_file = trim(inputdir)//trim(CS%tracer_IC_file) - call log_param(param_file, mod, "INPUTDIR/Elizabeth_TRACER_IC_FILE", & + call log_param(param_file, mdl, "INPUTDIR/Elizabeth_TRACER_IC_FILE", & CS%tracer_IC_file) endif - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) - call get_param(param_file, mod, "LENLAT", CS%lenlat, & + call get_param(param_file, mdl, "LENLAT", CS%lenlat, & "The latitudinal or y-direction length of the domain", & fail_if_missing=.true., do_not_log=.true.) - call get_param(param_file, mod, "LENLON", CS%lenlon, & + call get_param(param_file, mdl, "LENLON", CS%lenlon, & "The longitudinal or x-direction length of the domain", & fail_if_missing=.true., do_not_log=.true.) - call get_param(param_file, mod, "CONT_SHELF_LENGTH", CS%CSL, & + call get_param(param_file, mdl, "CONT_SHELF_LENGTH", CS%CSL, & "The length of the continental shelf (x dir, km).", & default=15.0) - call get_param(param_file, mod, "LENSPONGE", CS%lensponge, & + call get_param(param_file, mdl, "LENSPONGE", CS%lensponge, & "The length of the sponge layer (km).", & default=10.0) @@ -156,17 +157,18 @@ function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, & if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif write(longname,'("Concentration of Elizabeth Tracer ",I2.2)') m - CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mod) + CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) ! This is needed to force the compiler not to do a copy in the registration ! calls. Curses on the designers and implementers of Fortran90. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for the restart file. - call register_restart_field(tr_ptr, CS%tr_desc(m), .true., restart_CS) +! call register_restart_field(tr_ptr, CS%tr_desc(m), .true., restart_CS) ! Register the tracer for horizontal advection & diffusion. - call register_tracer(tr_ptr, CS%tr_desc(m), param_file, HI, GV, tr_Reg, & - tr_desc_ptr=CS%tr_desc(m)) - + call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + name=name, longname=longname, units="kg kg-1", & + registry_diags=.true., flux_units="kg/s", & + restart_CS=restart_CS) enddo CS%tr_Reg => tr_Reg @@ -247,30 +249,30 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! Register the tracer for the restart file. call query_vardesc(CS%tr_desc(m), name, units=units, longname=longname, & caller="initialize_Elizabeth_tracer") - CS%id_tracer(m) = register_diag_field("ocean_model", trim(name), CS%diag%axesTL, & - day, trim(longname) , trim(units)) - CS%id_tr_adx(m) = register_diag_field("ocean_model", trim(name)//"_adx", & - CS%diag%axesCuL, day, trim(longname)//" advective zonal flux" , & - trim(flux_units)) - CS%id_tr_ady(m) = register_diag_field("ocean_model", trim(name)//"_ady", & - CS%diag%axesCvL, day, trim(longname)//" advective meridional flux" , & - trim(flux_units)) - CS%id_tr_dfx(m) = register_diag_field("ocean_model", trim(name)//"_dfx", & - CS%diag%axesCuL, day, trim(longname)//" diffusive zonal flux" , & - trim(flux_units)) - CS%id_tr_dfy(m) = register_diag_field("ocean_model", trim(name)//"_dfy", & - CS%diag%axesCvL, day, trim(longname)//" diffusive zonal flux" , & - trim(flux_units)) - if (CS%id_tr_adx(m) > 0) call safe_alloc_ptr(CS%tr_adx(m)%p,IsdB,IedB,jsd,jed,nz) - if (CS%id_tr_ady(m) > 0) call safe_alloc_ptr(CS%tr_ady(m)%p,isd,ied,JsdB,JedB,nz) - if (CS%id_tr_dfx(m) > 0) call safe_alloc_ptr(CS%tr_dfx(m)%p,IsdB,IedB,jsd,jed,nz) - if (CS%id_tr_dfy(m) > 0) call safe_alloc_ptr(CS%tr_dfy(m)%p,isd,ied,JsdB,JedB,nz) +! CS%id_tracer(m) = register_diag_field("ocean_model", trim(name), CS%diag%axesTL, & +! day, trim(longname) , trim(units)) +! CS%id_tr_adx(m) = register_diag_field("ocean_model", trim(name)//"_adx", & +! CS%diag%axesCuL, day, trim(longname)//" advective zonal flux" , & +! trim(flux_units)) +! CS%id_tr_ady(m) = register_diag_field("ocean_model", trim(name)//"_ady", & +! CS%diag%axesCvL, day, trim(longname)//" advective meridional flux" , & +! trim(flux_units)) +! CS%id_tr_dfx(m) = register_diag_field("ocean_model", trim(name)//"_dfx", & +! CS%diag%axesCuL, day, trim(longname)//" diffusive zonal flux" , & +! trim(flux_units)) +! CS%id_tr_dfy(m) = register_diag_field("ocean_model", trim(name)//"_dfy", & +! CS%diag%axesCvL, day, trim(longname)//" diffusive zonal flux" , & +! trim(flux_units)) +! if (CS%id_tr_adx(m) > 0) call safe_alloc_ptr(CS%tr_adx(m)%p,IsdB,IedB,jsd,jed,nz) +! if (CS%id_tr_ady(m) > 0) call safe_alloc_ptr(CS%tr_ady(m)%p,isd,ied,JsdB,JedB,nz) +! if (CS%id_tr_dfx(m) > 0) call safe_alloc_ptr(CS%tr_dfx(m)%p,IsdB,IedB,jsd,jed,nz) +! if (CS%id_tr_dfy(m) > 0) call safe_alloc_ptr(CS%tr_dfy(m)%p,isd,ied,JsdB,JedB,nz) ! Register the tracer for horizontal advection & diffusion. - if ((CS%id_tr_adx(m) > 0) .or. (CS%id_tr_ady(m) > 0) .or. & - (CS%id_tr_dfx(m) > 0) .or. (CS%id_tr_dfy(m) > 0)) & - call add_tracer_diagnostics(name, CS%tr_Reg, CS%tr_adx(m)%p, & - CS%tr_ady(m)%p, CS%tr_dfx(m)%p, CS%tr_dfy(m)%p) +! if ((CS%id_tr_adx(m) > 0) .or. (CS%id_tr_ady(m) > 0) .or. & +! (CS%id_tr_dfx(m) > 0) .or. (CS%id_tr_dfy(m) > 0)) & +! call add_tracer_diagnostics(name, CS%tr_Reg, CS%tr_adx(m)%p, & +! CS%tr_ady(m)%p, CS%tr_dfx(m)%p, CS%tr_dfy(m)%p) call register_Z_tracer(CS%tr(:,:,:,m), trim(name), longname, units, & day, G, diag_to_Z_CSp) @@ -281,12 +283,17 @@ end subroutine initialize_Elizabeth_tracer !> This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. -subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, dt, G, GV, CS) +subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & + aggregate_FW_forcing, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G type(verticalGrid_type), intent(in) :: GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb + type(forcing), intent(in) :: fluxes real, intent(in) :: dt type(Elizabeth_tracer_CS), pointer :: CS + logical, optional,intent(in) :: aggregate_FW_forcing + real, optional,intent(in) :: evap_CFL_limit + real, optional,intent(in) :: minimum_forcing_depth ! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. ! (in) h_new - Layer thickness after entrainment, in m or kg m-2. @@ -296,6 +303,8 @@ subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, dt, G, GV, CS ! (in) eb - an array to which the amount of fluid entrained ! from the layer below during this call will be ! added, in m or kg m-2. +! (in) fluxes - A structure containing pointers to any possible +! forcing fields. Unused fields have NULL ptrs. ! (in) dt - The amount of time covered by this call, in s. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. @@ -305,22 +314,27 @@ subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, dt, G, GV, CS ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] - real :: mmax, area real :: b1(SZI_(G)) ! b1 and c1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real :: melt(SZI_(G),SZJ_(G)) ! melt water (positive for melting + ! negative for freezing) + real :: salt_flux(SZI_(G),SZJ_(G)) ! salt flux, positive into ocean + real :: mass(SZI_(G),SZJ_(G)) ! mass of water in the mixed layer (approximate) + real :: in_flux(SZI_(G),SZJ_(G),2) ! total amount of tracer to be injected + integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not.associated(CS)) return + in_flux(:,:,:) = 0.0 m=1 do j=js,je ; do i=is,ie - ! Set tracer to 1.0 in the surface of the continental shelf - if (G%geoLonT(i,j) <= (CS%CSL) then - CS%tr(i,j,1,m) = 1.0 ! first layer - endif - + !set tracer to 1.0 in the surface of the continental shelf + if (G%geoLonT(i,j) <= (CS%CSL)) then + CS%tr(i,j,1,m) = 1.0 !first layer + endif enddo ; enddo do j=js,je ; do i=is,ie @@ -331,6 +345,22 @@ subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, dt, G, GV, CS enddo ; enddo + if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then + do m=1,NTR + 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%tr(:,:,:,m) , dt, fluxes, h_work, & + evap_CFL_limit, minimum_forcing_depth, in_flux(:,:,m)) + + call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo + else + do m=1,NTR + call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo + endif + if (CS%mask_tracers) then do m = 1,NTR ; if (CS%id_tracer(m) > 0) then do k=1,nz ; do j=js,je ; do i=is,ie diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 6109fc4ddd..8208f46461 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -238,7 +238,7 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) register_ISOMIP_tracer(HI, GV, param_file, CS%ISOMIP_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_Elizabeth_tracer) CS%use_Elizabeth_tracer = & - register_Elizabeth_tracer(HI, GV, param_file, CS%Elizabeth_tracer_CSp & + register_Elizabeth_tracer(HI, GV, param_file, CS%Elizabeth_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_ideal_age) CS%use_ideal_age = & register_ideal_age_tracer(HI, GV, param_file, CS%ideal_age_tracer_CSp, & @@ -511,6 +511,11 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, CS%ISOMIP_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) + if (CS%use_Elizabeth_tracer) & + call Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & + G, GV, CS%Elizabeth_tracer_CSp, & + evap_CFL_limit=evap_CFL_limit, & + minimum_forcing_depth=minimum_forcing_depth) if (CS%use_ideal_age) & call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, CS%ideal_age_tracer_CSp, & @@ -571,6 +576,9 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (CS%use_ISOMIP_tracer) & call ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, CS%ISOMIP_tracer_CSp) + if (CS%use_Elizabeth_tracer) & + call Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & + G, GV, CS%Elizabeth_tracer_CSp) if (CS%use_ideal_age) & call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, CS%ideal_age_tracer_CSp) From 55afe76ef0aa58ddf429b14a1d65480b44564866 Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Thu, 7 Jun 2018 13:20:35 -0400 Subject: [PATCH 004/106] Adding the tracer sponge --- .../vertical/MOM_ALE_sponge.F90 | 329 ++++++++++-------- src/tracer/Elizabeth_tracer.F90 | 73 ++-- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/user/Elizabeth_initialization.F90 | 2 + 4 files changed, 229 insertions(+), 177 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index e7fe81dbd8..1b2dd77928 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -21,7 +21,6 @@ module MOM_ALE_sponge use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer - ! GMM - Planned extension: Support for time varying sponge targets. implicit none ; private @@ -44,6 +43,7 @@ module MOM_ALE_sponge end interface !< Publicly available functions public set_up_ALE_sponge_field, set_up_ALE_sponge_vel_field +public get_ALE_sponge_thicknesses, get_ALE_sponge_nz_data public initialize_ALE_sponge, apply_ALE_sponge, ALE_sponge_end, init_ALE_sponge_diags type :: p3d @@ -114,12 +114,14 @@ module MOM_ALE_sponge ! heights. subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_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 thicknesses of the sponge input layers. (in). - integer, intent(in) :: nz_data !< The total number of sponge input layers (in). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + integer, intent(in) :: nz_data !< The total number of sponge input layers (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values (in). + type(ALE_sponge_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 thicknesses of the sponge input layers. ! This include declares and sets the variable "version". @@ -166,6 +168,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + CS%new_sponges = .false. CS%nz = G%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 @@ -178,13 +181,10 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ CS%num_col = CS%num_col + 1 enddo ; enddo - if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 - ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -194,16 +194,12 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ col = col +1 endif enddo ; enddo - ! same for total number of arbritary layers and correspondent data CS%nz_data = nz_data allocate(CS%Ref_h%p(CS%nz_data,CS%num_col)) do col=1,CS%num_col ; do K=1,CS%nz_data CS%Ref_h%p(K,col) = data_h(CS%col_i(col),CS%col_j(col),K) - enddo; enddo - CS%new_sponges = .false. - - + enddo ; enddo endif total_sponge_cols = CS%num_col @@ -217,86 +213,135 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ if (CS%sponge_uv) then - allocate(data_hu(G%isdB:G%iedB,G%jsd:G%jed,nz_data)); data_hu(:,:,:)=0.0 - allocate(data_hv(G%isd:G%ied,G%jsdB:G%jedB,nz_data)); data_hv(:,:,:)=0.0 - allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)); Iresttime_u(:,:)=0.0 - allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)); Iresttime_v(:,:)=0.0 + allocate(data_hu(G%isdB:G%iedB,G%jsd:G%jed,nz_data)); data_hu(:,:,:)=0.0 + allocate(data_hv(G%isd:G%ied,G%jsdB:G%jedB,nz_data)); data_hv(:,:,:)=0.0 + allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)); Iresttime_u(:,:)=0.0 + allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)); Iresttime_v(:,:)=0.0 - ! u points - CS%num_col_u = 0 ; !CS%fldno_u = 0 - do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB - data_hu(I,j,:) = 0.5 * (data_h(i,j,:) + data_h(i+1,j,:)) - Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) - if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & - CS%num_col_u = CS%num_col_u + 1 - enddo; enddo + ! u points + CS%num_col_u = 0 ; !CS%fldno_u = 0 + do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB + data_hu(I,j,:) = 0.5 * (data_h(i,j,:) + data_h(i+1,j,:)) + Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) + if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & + CS%num_col_u = CS%num_col_u + 1 + enddo ; enddo - if (CS%num_col_u > 0) then + if (CS%num_col_u > 0) then - allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u = 0.0 - allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u = 0 - allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u = 0 + allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u = 0.0 + allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u = 0 + allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u = 0 - ! pass indices, restoring time to the CS structure - col = 1 - do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB - if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then - CS%col_i_u(col) = i ; CS%col_j_u(col) = j - CS%Iresttime_col_u(col) = Iresttime_u(i,j) - col = col +1 - endif - enddo ; enddo + ! pass indices, restoring time to the CS structure + col = 1 + do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB + if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then + CS%col_i_u(col) = i ; CS%col_j_u(col) = j + CS%Iresttime_col_u(col) = Iresttime_u(i,j) + col = col +1 + endif + enddo ; enddo - ! same for total number of arbritary layers and correspondent data + ! same for total number of arbritary layers and correspondent data - allocate(CS%Ref_hu%p(CS%nz_data,CS%num_col_u)) - do col=1,CS%num_col_u ; do K=1,CS%nz_data - CS%Ref_hu%p(K,col) = data_hu(CS%col_i_u(col),CS%col_j_u(col),K) - enddo; enddo - endif - total_sponge_cols_u = CS%num_col_u - call sum_across_PEs(total_sponge_cols_u) - call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, & - "The total number of columns where sponges are applied at u points.") + allocate(CS%Ref_hu%p(CS%nz_data,CS%num_col_u)) + do col=1,CS%num_col_u ; do K=1,CS%nz_data + CS%Ref_hu%p(K,col) = data_hu(CS%col_i_u(col),CS%col_j_u(col),K) + enddo ; enddo + endif + total_sponge_cols_u = CS%num_col_u + call sum_across_PEs(total_sponge_cols_u) + call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, & + "The total number of columns where sponges are applied at u points.") - ! v points - CS%num_col_v = 0 ; !CS%fldno_v = 0 - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec - data_hv(i,J,:) = 0.5 * (data_h(i,j,:) + data_h(i,j+1,:)) - Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) - if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & - CS%num_col_v = CS%num_col_v + 1 - enddo; enddo + ! v points + CS%num_col_v = 0 ; !CS%fldno_v = 0 + do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + data_hv(i,J,:) = 0.5 * (data_h(i,j,:) + data_h(i,j+1,:)) + Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) + if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & + CS%num_col_v = CS%num_col_v + 1 + enddo ; enddo - if (CS%num_col_v > 0) then + if (CS%num_col_v > 0) then + + allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 + allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 + allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 + + ! pass indices, restoring time to the CS structure + col = 1 + do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec + if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then + CS%col_i_v(col) = i ; CS%col_j_v(col) = j + CS%Iresttime_col_v(col) = Iresttime_v(i,j) + col = col +1 + endif + enddo ; enddo + + ! same for total number of arbritary layers and correspondent data + allocate(CS%Ref_hv%p(CS%nz_data,CS%num_col_v)) + do col=1,CS%num_col_v ; do K=1,CS%nz_data + CS%Ref_hv%p(K,col) = data_hv(CS%col_i_v(col),CS%col_j_v(col),K) + enddo ; enddo + endif + total_sponge_cols_v = CS%num_col_v + call sum_across_PEs(total_sponge_cols_v) + call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, & + "The total number of columns where sponges are applied at v points.") + endif - allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 - allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 - allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 +end subroutine initialize_ALE_sponge_fixed - ! pass indices, restoring time to the CS structure - col = 1 - do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec - if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then - CS%col_i_v(col) = i ; CS%col_j_v(col) = j - CS%Iresttime_col_v(col) = Iresttime_v(i,j) - col = col +1 - endif - enddo ; enddo +!> 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. + integer :: get_ALE_sponge_nz_data !< The number of layers in the fixed sponge data. - ! same for total number of arbritary layers and correspondent data - allocate(CS%Ref_hv%p(CS%nz_data,CS%num_col_v)) - do col=1,CS%num_col_v ; do K=1,CS%nz_data - CS%Ref_hv%p(K,col) = data_hv(CS%col_i_v(col),CS%col_j_v(col),K) - enddo ; enddo - endif - total_sponge_cols_v = CS%num_col_v - call sum_across_PEs(total_sponge_cols_v) - call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, & - "The total number of columns where sponges are applied at v points.") + if (associated(CS)) then + get_ALE_sponge_nz_data = CS%nz_data + else + get_ALE_sponge_nz_data = 0 + endif +end function get_ALE_sponge_nz_data + +!> Return the thicknesses used for the data with a fixed ALE sponge +subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + real, allocatable, dimension(:,:,:), & + intent(inout) :: data_h !< The thicknesses of the sponge input layers. + logical, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: sponge_mask !< A logical mask that is true where + !! sponges are being applied. + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for the ALE_sponge module. + integer :: c, i, j, k + + if (allocated(data_h)) call MOM_error(FATAL, & + "get_ALE_sponge_thicknesses called with an allocated data_h.") + + if (.not.associated(CS)) then + ! There are no sponge points on this PE. + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,1)) ; data_h(:,:,:) = -1.0 + sponge_mask(:,:) = .false. + return endif -end subroutine initialize_ALE_sponge_fixed + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) ; data_h(:,:,:) = -1.0 + sponge_mask(:,:) = .false. + + do c=1,CS%num_col + i = CS%col_i(c) ; j = CS%col_j(c) + sponge_mask(i,j) = .true. + do k=1,CS%nz_data + data_h(i,j,k) = CS%Ref_h%p(k,c) + enddo + enddo + +end subroutine get_ALE_sponge_thicknesses !> This subroutine determines the number of points which are within ! sponges in this computational domain. Only points that have @@ -305,10 +350,12 @@ end subroutine initialize_ALE_sponge_fixed ! heights. subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_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 (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse + !! for model parameter values (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). @@ -354,6 +401,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + CS%new_sponges = .true. CS%nz = G%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 @@ -368,11 +416,9 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 - ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -382,9 +428,6 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) col = col +1 endif enddo ; enddo - - CS%new_sponges = .true. - endif total_sponge_cols = CS%num_col @@ -407,7 +450,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & CS%num_col_u = CS%num_col_u + 1 - enddo; enddo + enddo ; enddo if (CS%num_col_u > 0) then @@ -439,7 +482,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & CS%num_col_v = CS%num_col_v + 1 - enddo; enddo + enddo ; enddo if (CS%num_col_v > 0) then @@ -481,12 +524,14 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS) end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable -! whose address is given by f_ptr. +!! whose address is given by f_ptr. subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZI_(G),SZJ_(G),CS%nz_data), intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZI_(G),SZJ_(G),CS%nz_data), & + intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -518,12 +563,13 @@ end subroutine set_up_ALE_sponge_field_fixed !> This subroutine stores the reference profile at h points for the variable ! whose address is given by filename and fieldname. subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, CS) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: fieldname - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: fieldname + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data @@ -613,7 +659,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, if (hsrc(k)>0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! In case data is deeper than model + ! In case data is deeper than model + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) @@ -628,15 +675,17 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, end subroutine set_up_ALE_sponge_field_varying -!> This subroutine stores the reference profile at uand v points for the variable -! whose address is given by u_ptr and v_ptr. +!> This subroutine stores the reference profile at u and v points for the variable +!! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJB_(G),CS%nz_data), intent(in) :: v_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), & + intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJB_(G),CS%nz_data), & + intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -667,7 +716,7 @@ subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at uand v points for the variable -! whose address is given by u_ptr and v_ptr. +!! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v,fieldname_v, Time, G, CS, u_ptr, v_ptr) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file @@ -762,23 +811,26 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v end subroutine set_up_ALE_sponge_vel_field_varying -!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers for every column where there is damping. +!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers +!! for every column where there is damping. subroutine apply_ALE_sponge(h, dt, G, CS, Time) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness, in m (in) - real, intent(in) :: dt !< The amount of time covered by this call, in s (in). - type(ALE_sponge_CS), pointer :: CS ! A temporary array for h at u pts - real :: hv(SZI_(G), SZJB_(G), SZK_(G)) !> A temporary array for h at v pts - real, allocatable, dimension(:,:,:) :: sp_val !> A temporary array for fields - real, allocatable, dimension(:,:,:) :: mask_z !> A temporary array for field mask at h pts + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Layer thickness, in m (in) + real, intent(in) :: dt !< The amount of time covered by this call, in s (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module + !! that is set by a previous call to initialize_sponge (in). + type(time_type), optional, intent(in) :: Time !< The current model date + + real :: damp ! The timestep times the local damping coefficient. ND. + real :: I1pdamp ! I1pdamp is 1/(1 + damp). Nondimensional. + real :: Idt ! 1.0/dt, in s-1. + real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid + real, dimension(SZK_(G)) :: tmp_val1 ! data values remapped to model grid + real :: hu(SZIB_(G), SZJ_(G), SZK_(G)) ! A temporary array for h at u pts + real :: hv(SZI_(G), SZJB_(G), SZK_(G)) ! A temporary array for h at v pts + real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields + real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz, nz_data real, allocatable, dimension(:), target :: z_in, z_edges_in real :: missing_value @@ -801,8 +853,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) mask_z(:,:,:)=0.0 call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in,& - missing_value,.true.,& - .false.,.false.) + missing_value,.true., .false.,.false.) ! call pass_var(sp_val,G%Domain) ! call pass_var(mask_z,G%Domain) @@ -813,9 +864,10 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) CS%Ref_val(m)%p(1:nz_data,c) = sp_val(i,j,1:nz_data) do k=2,nz_data ! if (mask_z(i,j,k)==0.) & - if (CS%Ref_val(m)%h(k,c) <= 0.001) & ! some confusion here about why the masks are not correct returning from horiz_interp - ! reverting to using a minimum thickness criteria - CS%Ref_val(m)%p(k,c)=CS%Ref_val(m)%p(k-1,c) + if (CS%Ref_val(m)%h(k,c) <= 0.001) & + ! some confusion here about why the masks are not correct returning from horiz_interp + ! reverting to using a minimum thickness criteria + CS%Ref_val(m)%p(k,c) = CS%Ref_val(m)%p(k-1,c) enddo enddo @@ -825,10 +877,8 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) nz_data = CS%nz_data endif - allocate(tmp_val2(nz_data)) - do m=1,CS%fldno do c=1,CS%num_col ! c is an index for the next 3 lines but a multiplier for the rest of the loop @@ -863,7 +913,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) ! u points do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB; do k=1,nz hu(I,j,k) = 0.5 * (h(i,j,k) + h(i+1,j,k)) - enddo; enddo; enddo + enddo ; enddo ; enddo if (CS%new_sponges) then if (.not. present(Time)) & @@ -909,7 +959,6 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) deallocate (sp_val, mask_z) - else nz_data = CS%nz_data endif @@ -936,7 +985,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) ! v points do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec; do k=1,nz hv(i,J,k) = 0.5 * (h(i,j,k) + h(i,j+1,k)) - enddo; enddo; enddo + enddo ; enddo ; enddo do c=1,CS%num_col_v i = CS%col_i_v(c) ; j = CS%col_j_v(c) diff --git a/src/tracer/Elizabeth_tracer.F90 b/src/tracer/Elizabeth_tracer.F90 index 273defb3c5..747f6e4bff 100644 --- a/src/tracer/Elizabeth_tracer.F90 +++ b/src/tracer/Elizabeth_tracer.F90 @@ -26,11 +26,10 @@ module Elizabeth_tracer use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc use MOM_restart, only : register_restart_field, MOM_restart_CS -use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS +use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS, get_ALE_sponge_nz_data use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -!use MOM_tracer_registry, only : add_tracer_diagnostics use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface use MOM_open_boundary, only : ocean_OBC_type @@ -188,7 +187,7 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(diag_ctrl), target, intent(in) :: diag type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. type(Elizabeth_tracer_CS), pointer :: CS !< The control structure returned by a previous call to Elizabeth_register_tracer. - 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. + type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure for diagnostics in depth space. real, allocatable :: temp(:,:,:) @@ -211,6 +210,7 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & real :: e(SZK_(G)+1), e_top, e_bot, d_tr integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB + integer :: nzdata if (.not.associated(CS)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -238,9 +238,43 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & CS%tr(i,j,k,m) = 0.0 enddo ; enddo ; enddo enddo + m=1 + do j=js,je ; do i=is,ie + !set tracer to 1.0 in the surface of the continental shelf + if (G%geoLonT(i,j) <= (CS%CSL)) then + CS%tr(i,j,1,m) = 1.0 !first layer + endif + enddo ; enddo + endif endif ! restart + if ( CS%use_sponge ) then +! If sponges are used, this damps values to zero in the offshore boundary. +! For any tracers that are not damped in the sponge, the call +! to set_up_sponge_field can simply be omitted. + if (.not.associated(sponge_CSp)) & + call MOM_error(FATAL, "Elizabeth_initialize_tracer: "// & + "The pointer to sponge_CSp must be associated if SPONGE is defined.") + nzdata = get_ALE_sponge_nz_data(sponge_CSp) + if (nzdata>0) then + allocate(temp(G%isd:G%ied,G%jsd:G%jed,nzdata)) + do k=1,nzdata ; do j=js,je ; do i=is,ie + if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + temp(i,j,k) = 0.0 + endif + enddo ; enddo; enddo +! do m=1,NTR + do m=1,1 + ! This is needed to force the compiler not to do a copy in the sponge + ! calls. Curses on the designers and implementers of Fortran90. + tr_ptr => CS%tr(:,:,:,m) + call set_up_ALE_sponge_field(temp, G, tr_ptr, sponge_CSp) + enddo + deallocate(temp) + endif + endif + ! This needs to be changed if the units of tracer are changed above. if (GV%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1" else ; flux_units = "kg s-1" ; endif @@ -249,31 +283,6 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! Register the tracer for the restart file. call query_vardesc(CS%tr_desc(m), name, units=units, longname=longname, & caller="initialize_Elizabeth_tracer") -! CS%id_tracer(m) = register_diag_field("ocean_model", trim(name), CS%diag%axesTL, & -! day, trim(longname) , trim(units)) -! CS%id_tr_adx(m) = register_diag_field("ocean_model", trim(name)//"_adx", & -! CS%diag%axesCuL, day, trim(longname)//" advective zonal flux" , & -! trim(flux_units)) -! CS%id_tr_ady(m) = register_diag_field("ocean_model", trim(name)//"_ady", & -! CS%diag%axesCvL, day, trim(longname)//" advective meridional flux" , & -! trim(flux_units)) -! CS%id_tr_dfx(m) = register_diag_field("ocean_model", trim(name)//"_dfx", & -! CS%diag%axesCuL, day, trim(longname)//" diffusive zonal flux" , & -! trim(flux_units)) -! CS%id_tr_dfy(m) = register_diag_field("ocean_model", trim(name)//"_dfy", & -! CS%diag%axesCvL, day, trim(longname)//" diffusive zonal flux" , & -! trim(flux_units)) -! if (CS%id_tr_adx(m) > 0) call safe_alloc_ptr(CS%tr_adx(m)%p,IsdB,IedB,jsd,jed,nz) -! if (CS%id_tr_ady(m) > 0) call safe_alloc_ptr(CS%tr_ady(m)%p,isd,ied,JsdB,JedB,nz) -! if (CS%id_tr_dfx(m) > 0) call safe_alloc_ptr(CS%tr_dfx(m)%p,IsdB,IedB,jsd,jed,nz) -! if (CS%id_tr_dfy(m) > 0) call safe_alloc_ptr(CS%tr_dfy(m)%p,isd,ied,JsdB,JedB,nz) - -! Register the tracer for horizontal advection & diffusion. -! if ((CS%id_tr_adx(m) > 0) .or. (CS%id_tr_ady(m) > 0) .or. & -! (CS%id_tr_dfx(m) > 0) .or. (CS%id_tr_dfy(m) > 0)) & -! call add_tracer_diagnostics(name, CS%tr_Reg, CS%tr_adx(m)%p, & -! CS%tr_ady(m)%p, CS%tr_dfx(m)%p, CS%tr_dfy(m)%p) - call register_Z_tracer(CS%tr(:,:,:,m), trim(name), longname, units, & day, G, diag_to_Z_CSp) enddo @@ -337,14 +346,6 @@ subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G endif enddo ; enddo - do j=js,je ; do i=is,ie - ! remove tracer in the sponge layer - if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then - CS%tr(i,j,:,m) = 0.0 ! all layers - endif - - enddo ; enddo - if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do m=1,NTR do k=1,nz ;do j=js,je ; do i=is,ie diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 8208f46461..0d52270634 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -322,7 +322,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB ALE_sponge_CSp, diag_to_Z_CSp) if (CS%use_Elizabeth_tracer) & call initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, & - CS%Elizabeth_tracer_CSp, sponge_CSp, diag_to_Z_CSp) + CS%Elizabeth_tracer_CSp, ALE_sponge_CSp, diag_to_Z_CSp) if (CS%use_ideal_age) & call initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS%ideal_age_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) diff --git a/src/user/Elizabeth_initialization.F90 b/src/user/Elizabeth_initialization.F90 index 1d7a0f47fa..0a0f9e1831 100644 --- a/src/user/Elizabeth_initialization.F90 +++ b/src/user/Elizabeth_initialization.F90 @@ -37,6 +37,7 @@ module Elizabeth_initialization use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA +use MOM_domains, only: pass_var implicit none ; private #include @@ -201,6 +202,7 @@ subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) if (use_ALE) then call read_data(filename,h_var,h(:,:,:), domain=G%Domain%mpp_domain) + call pass_var(h, G%domain) !call initialize_ALE_sponge(Idamp, h, nz, G, PF, ACSp) call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz) From 3601804465a7f486cd20cdbe4a9c49cadc8d1c9d Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Tue, 9 Oct 2018 20:09:34 -0400 Subject: [PATCH 005/106] Updating tracer for layered case --- src/tracer/Elizabeth_tracer.F90 | 63 +++++++++++++++++--------- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/user/Elizabeth_initialization.F90 | 4 +- 3 files changed, 44 insertions(+), 25 deletions(-) diff --git a/src/tracer/Elizabeth_tracer.F90 b/src/tracer/Elizabeth_tracer.F90 index 747f6e4bff..36b40d62e2 100644 --- a/src/tracer/Elizabeth_tracer.F90 +++ b/src/tracer/Elizabeth_tracer.F90 @@ -177,7 +177,7 @@ end function register_Elizabeth_tracer !> Initializes the NTR tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp) + layer_CSp, sponge_CSp, diag_to_Z_CSp) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -186,8 +186,9 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(diag_ctrl), target, intent(in) :: diag type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. - type(Elizabeth_tracer_CS), pointer :: CS !< The control structure returned by a previous call to Elizabeth_register_tracer. - type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. + type(Elizabeth_tracer_CS), pointer :: CS !< The control structure returned by a previous call to Elizabeth_register_tracer. + type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure + type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure for diagnostics in depth space. real, allocatable :: temp(:,:,:) @@ -253,27 +254,45 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! If sponges are used, this damps values to zero in the offshore boundary. ! For any tracers that are not damped in the sponge, the call ! to set_up_sponge_field can simply be omitted. - if (.not.associated(sponge_CSp)) & + if (associated(sponge_CSp)) then !ALE mode + nzdata = get_ALE_sponge_nz_data(sponge_CSp) + if (nzdata>0) then + allocate(temp(G%isd:G%ied,G%jsd:G%jed,nzdata)) + do k=1,nzdata ; do j=js,je ; do i=is,ie + if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + temp(i,j,k) = 0.0 + endif + enddo ; enddo; enddo + do m=1,1 + ! This is needed to force the compiler not to do a copy in the sponge + ! calls. Curses on the designers and implementers of Fortran90. + tr_ptr => CS%tr(:,:,:,m) + call set_up_ALE_sponge_field(temp, G, tr_ptr, sponge_CSp) + enddo + deallocate(temp) + endif +! endif !ALE mode + + elseif (associated(layer_CSp)) then !layer mode + if (nz>0) then + allocate(temp(G%isd:G%ied,G%jsd:G%jed,nz)) + do k=1,nz ; do j=js,je ; do i=is,ie + if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + temp(i,j,k) = 0.0 + endif + enddo ; enddo; enddo + do m=1,1 + tr_ptr => CS%tr(:,:,:,m) + call set_up_sponge_field(temp, tr_ptr, G, nz, layer_CSp) + enddo + deallocate(temp) + endif +! endif !Layer mode + else call MOM_error(FATAL, "Elizabeth_initialize_tracer: "// & "The pointer to sponge_CSp must be associated if SPONGE is defined.") - nzdata = get_ALE_sponge_nz_data(sponge_CSp) - if (nzdata>0) then - allocate(temp(G%isd:G%ied,G%jsd:G%jed,nzdata)) - do k=1,nzdata ; do j=js,je ; do i=is,ie - if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then - temp(i,j,k) = 0.0 - endif - enddo ; enddo; enddo -! do m=1,NTR - do m=1,1 - ! This is needed to force the compiler not to do a copy in the sponge - ! calls. Curses on the designers and implementers of Fortran90. - tr_ptr => CS%tr(:,:,:,m) - call set_up_ALE_sponge_field(temp, G, tr_ptr, sponge_CSp) - enddo - deallocate(temp) - endif - endif + endif !selecting mode/calling error if no pointer + endif !using sponge ! This needs to be changed if the units of tracer are changed above. if (GV%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1" diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 0d52270634..6cc3804012 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -322,7 +322,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB ALE_sponge_CSp, diag_to_Z_CSp) if (CS%use_Elizabeth_tracer) & call initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, & - CS%Elizabeth_tracer_CSp, ALE_sponge_CSp, diag_to_Z_CSp) + CS%Elizabeth_tracer_CSp, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp) if (CS%use_ideal_age) & call initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS%ideal_age_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) diff --git a/src/user/Elizabeth_initialization.F90 b/src/user/Elizabeth_initialization.F90 index 0a0f9e1831..6c984a687d 100644 --- a/src/user/Elizabeth_initialization.F90 +++ b/src/user/Elizabeth_initialization.F90 @@ -218,10 +218,10 @@ subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) if (sponge_uv) then U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) - endif + - else ! layer mode + else ! layer mode !read eta call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) From cf306fce03c894b6afa335a95814f38f76442ae8 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Thu, 6 Dec 2018 11:53:57 -0600 Subject: [PATCH 006/106] Bug fix in biharmonic Leith implementation --- 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 3be015faa4..a241c8a605 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -630,7 +630,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif endif if (CS%Leith_Ah) & - AhLth = Vort_mag * (CS%BIHARM_CONST_xx(i,j)) + AhLth = Vort_mag * (CS%BIHARM5_CONST_xx(i,j)) Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) From 2924ddd485b1bfe157add9efae319b518a1eda41 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Fri, 7 Dec 2018 12:02:28 -0600 Subject: [PATCH 007/106] Modified MEKE code to choose mixing length a simple minimum of provided scales Notice that this modification currently replaces existing code. If we want this as an option in the model it needs to be implemented properly as an option with the default being the original implementation to ensure reproduction of existing reults. --- src/parameterizations/lateral/MOM_MEKE.F90 | 23 ++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index a7433c58bb..bbf6163c58 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -771,14 +771,21 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & else Leady = 0. endif - LmixScale = 0. - if (CS%aDeform*Ldeform > 0.) LmixScale = LmixScale + 1./(CS%aDeform*Ldeform) - if (CS%aFrict *Lfrict > 0.) LmixScale = LmixScale + 1./(CS%aFrict *Lfrict) - if (CS%aRhines*Lrhines > 0.) LmixScale = LmixScale + 1./(CS%aRhines*Lrhines) - if (CS%aEady *Leady > 0.) LmixScale = LmixScale + 1./(CS%aEady *Leady) - if (CS%aGrid *Lgrid > 0.) LmixScale = LmixScale + 1./(CS%aGrid *Lgrid) - if (CS%Lfixed > 0.) LmixScale = LmixScale + 1./CS%Lfixed - if (LmixScale > 0.) LmixScale = 1. / LmixScale + !LmixScale = 0. + !if (CS%aDeform*Ldeform > 0.) LmixScale = LmixScale + 1./(CS%aDeform*Ldeform) + !if (CS%aFrict *Lfrict > 0.) LmixScale = LmixScale + 1./(CS%aFrict *Lfrict) + !if (CS%aRhines*Lrhines > 0.) LmixScale = LmixScale + 1./(CS%aRhines*Lrhines) + !if (CS%aEady *Leady > 0.) LmixScale = LmixScale + 1./(CS%aEady *Leady) + !if (CS%aGrid *Lgrid > 0.) LmixScale = LmixScale + 1./(CS%aGrid *Lgrid) + !if (CS%Lfixed > 0.) LmixScale = LmixScale + 1./CS%Lfixed + !if (LmixScale > 0.) LmixScale = 1. / LmixScale + LmixScale = 1.e7 + if (CS%aDeform*Ldeform > 0.) LmixScale = min(LmixScale,CS%aDeform*Ldeform) + if (CS%aFrict *Lfrict > 0.) LmixScale = min(LmixScale,CS%aFrict *Lfrict) + if (CS%aRhines*Lrhines > 0.) LmixScale = min(LmixScale,CS%aRhines*Lrhines) + if (CS%aEady *Leady > 0.) LmixScale = min(LmixScale,CS%aEady *Leady) + if (CS%aGrid *Lgrid > 0.) LmixScale = min(LmixScale,CS%aGrid *Lgrid) + if (CS%Lfixed > 0.) LmixScale = min(LmixScale,CS%Lfixed) endif end subroutine MEKE_lengthScales_0d From db98e9e97b97ab85edd1d5fdcae9f2eb79077ddb Mon Sep 17 00:00:00 2001 From: MFJansen Date: Tue, 5 Feb 2019 11:52:10 -0600 Subject: [PATCH 008/106] Changed order in viscosity computation to allow negative viscosity and resolution func --- src/parameterizations/lateral/MOM_hor_visc.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a241c8a605..6b0ecdc366 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -582,12 +582,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xx(i,j) * Shear_mag ) if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xx(i,j) * Vort_mag ) + Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. + if (use_MEKE_Ku) Kh = Kh + MEKE%Ku(i,j) ! *Add* the MEKE contribution (might be negative) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh ! Older method of bounding for stability if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) - Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. - if (use_MEKE_Ku) Kh = Kh + MEKE%Ku(i,j) ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -742,15 +742,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xy(I,J) * Shear_mag ) if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xy(I,J) * Vort_mag) - ! All viscosity contributions above are subject to resolution scaling - if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh - ! Older method of bounding for stability - if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) Kh = max( Kh, 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 = Kh + 0.25*( (MEKE%Ku(I,J)+MEKE%Ku(I+1,J+1)) & +(MEKE%Ku(I+1,J)+MEKE%Ku(I,J+1)) ) endif + ! All viscosity contributions above are subject to resolution scaling + if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh + ! Older method of bounding for stability + if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! *Add* the shear component ! of anisotropic viscosity From 5c6d90614de8d2335a4a0d4bc24aa57976932679 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Wed, 6 Feb 2019 16:49:04 -0600 Subject: [PATCH 009/106] added grid-scale based Visbeck --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 4963ba4bf0..3f14dca2b0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -854,8 +854,19 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "VISBECK_L_SCALE", CS%Visbeck_L_scale, & "The fixed length scale in the Visbeck formula.", units="m", & default=0.0) - allocate(CS%L2u(IsdB:IedB,jsd:jed)) ; CS%L2u(:,:) = CS%Visbeck_L_scale**2 - allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = CS%Visbeck_L_scale**2 + allocate(CS%L2u(IsdB:IedB,jsd:jed)) ; CS%L2u(:,:) = 0.0 + allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 + if (CS%Visbeck_L_scale<0) then + do j=js,je ; do I=is-1,Ieq + CS%L2u(I,j) = CS%Visbeck_L_scale**2*G%areaCu(I,j) + enddo; enddo + do J=js-1,Jeq ; do i=is,ie + CS%L2v(i,J) = CS%Visbeck_L_scale**2*G%areaCv(i,J) + enddo; enddo + else + CS%L2u(:,:) = CS%Visbeck_L_scale**2 + CS%L2v(:,:) = CS%Visbeck_L_scale**2 + endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & 'Length scale squared for mixing coefficient, at u-points', 'm2') From ae105750a49c3562b9aac668b2115802cc1a68fd Mon Sep 17 00:00:00 2001 From: MFJansen Date: Thu, 7 Feb 2019 17:06:23 -0600 Subject: [PATCH 010/106] added biharmonic viscosity formulated as delta^4/Ah_time_scale --- src/parameterizations/lateral/MOM_hor_visc.F90 | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 6b0ecdc366..b38f6f666e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -981,6 +981,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: Ah ! biharmonic horizontal viscosity (m4/s) real :: Kh_vel_scale ! this speed (m/s) times grid spacing gives Lap visc real :: Ah_vel_scale ! this speed (m/s) times grid spacing cubed gives bih visc + real :: Ah_time_scale ! damping time-scale for biharmonic visc real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant real :: Leith_Lap_const ! nondimensional Laplacian Leith constant @@ -1142,6 +1143,12 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) "The final viscosity is the largest of this scaled \n"//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & units="m s-1", default=0.0) + call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & + "A time scale whose inverse is multiplied by the fourth \n"//& + "power of the grid spacing to calculate biharmonic viscosity. \n"//& + "The final viscosity is the largest of all viscosity \n"//& + "formulations in use. 0.0 means that it's not used.", & + units="s", default=0.0) call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy \n"//& "viscosity.", default=.false.) @@ -1459,6 +1466,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) + CS%Ah_bg_xx(i,j) = MAX(CS%Ah_bg_xx(i,j), (grid_sp_h2 * grid_sp_h2) / & + Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xx(i,j) = Ah_Limit * (grid_sp_h2 * grid_sp_h2) CS%Ah_bg_xx(i,j) = MIN(CS%Ah_bg_xx(i,j), CS%Ah_Max_xx(i,j)) @@ -1481,6 +1490,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) + CS%Ah_bg_xy(i,j) = MAX(CS%Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / & + Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xy(I,J) = Ah_Limit * (grid_sp_q2 * grid_sp_q2) CS%Ah_bg_xy(I,J) = MIN(CS%Ah_bg_xy(I,J), CS%Ah_Max_xy(I,J)) From 3ddcc4490a56628c04c0e11439873444aa6244f5 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Mon, 18 Feb 2019 09:06:28 -0600 Subject: [PATCH 011/106] Modified topographic beta to divide by largest H --- src/parameterizations/lateral/MOM_MEKE.F90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index bbf6163c58..b98c042cc0 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -581,9 +581,11 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m FatH = 0.25*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & - (G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH & + /max(G%bathyT(i,j),G%bathyT(i+1,j),G%bathyT(i-1,j),1.e-30) & + *(G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & + + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH & + /max(G%bathyT(i,j),G%bathyT(i,j+1),G%bathyT(i,j-1),1.e-30) & *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) I_H = GV%Rho0 * I_mass(i,j) @@ -705,9 +707,11 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & endif FatH = 0.25*( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH & + /max(G%bathyT(i,j),G%bathyT(i+1,j),G%bathyT(i-1,j),1.e-30) & *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH & + /max(G%bathyT(i,j),G%bathyT(i,j-1),G%bathyT(i,j+1),1.e-30) & *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) endif ! Returns bottomFac2, barotrFac2 and LmixScale From 3f7db9821e0da9eef9f9c0ed516ea5c9fd5b2dc0 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Sun, 31 Mar 2019 12:12:37 -0500 Subject: [PATCH 012/106] revised formulation of topographic beta and mixing length implementation The change in the formulation of topographic beta is only numerical For the mixing length one can now choose to either use the old (harmonic mean) formulation or the revised formulation where mixing length is hard maximum (Following Khani et al. in prep) a more generalized implementation with variable power harmonic mean (and hard min as limit case for very high power) may be a useful generalization for the future --- src/parameterizations/lateral/MOM_MEKE.F90 | 75 +++++++++++++--------- 1 file changed, 46 insertions(+), 29 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index b98c042cc0..f92cf94bf8 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -44,6 +44,7 @@ module MOM_MEKE logical :: Rd_as_max_scale !< If true the length scale can not exceed the !! first baroclinic deformation radius. logical :: use_old_lscale !< Use the old formula for mixing length scale. + logical :: use_min_lscale !< Use simple minimum for mixing length scale. real :: cdrag !< The bottom drag coefficient for MEKE (non-dim). real :: MEKE_BGsrc !< Background energy source for MEKE in W/kg (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping (non-dim.) @@ -257,7 +258,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! Calculates bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) + call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI) call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) @@ -581,12 +582,16 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m FatH = 0.25*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH & - /max(G%bathyT(i,j),G%bathyT(i+1,j),G%bathyT(i-1,j),1.e-30) & - *(G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH & - /max(G%bathyT(i,j),G%bathyT(i,j+1),G%bathyT(i,j-1),1.e-30) & - *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH*0.5*( & + (G%bathyT(i+1,j) - G%bathyT(i,j))*G%IdxCu(I,j) & + /max(G%bathyT(i,j),G%bathyT(i+1,j),GV%H_subroundoff) + & + (G%bathyT(i,j) - G%bathyT(i-1,j))*G%IdxCu(I-1,j) & + /max(G%bathyT(i,j),G%bathyT(i-1,j),GV%H_subroundoff)))**2. & + + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH *0.5*( & + (G%bathyT(i,j+1) - G%bathyT(i,j))*G%IdyCv(i,J) & + /max(G%bathyT(i,j),G%bathyT(i,j+1),GV%H_subroundoff) + & + (G%bathyT(i,j) - G%bathyT(i,j-1))*G%IdxCu(i,J-1) & + /max(G%bathyT(i,j),G%bathyT(i,j-1),GV%H_subroundoff)))**2.) I_H = GV%Rho0 * I_mass(i,j) @@ -678,11 +683,12 @@ end subroutine MEKE_equilibrium !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & +subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & EKE, bottomFac2, barotrFac2, LmixScale) type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: 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 real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). @@ -707,12 +713,16 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & endif FatH = 0.25*( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH & - /max(G%bathyT(i,j),G%bathyT(i+1,j),G%bathyT(i-1,j),1.e-30) & - *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH & - /max(G%bathyT(i,j),G%bathyT(i,j-1),G%bathyT(i,j+1),1.e-30) & - *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH*0.5*( & + (G%bathyT(i+1,j) - G%bathyT(i,j))*G%IdxCu(I,j) & + /max(G%bathyT(i,j),G%bathyT(i+1,j),GV%H_subroundoff) + & + (G%bathyT(i,j) - G%bathyT(i-1,j))*G%IdxCu(I-1,j) & + /max(G%bathyT(i,j),G%bathyT(i-1,j),GV%H_subroundoff)))**2. & + + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH *0.5*( & + (G%bathyT(i,j+1) - G%bathyT(i,j))*G%IdyCv(i,J) & + /max(G%bathyT(i,j),G%bathyT(i,j+1),GV%H_subroundoff) + & + (G%bathyT(i,j) - G%bathyT(i,j-1))*G%IdxCu(i,J-1) & + /max(G%bathyT(i,j),G%bathyT(i,j-1),GV%H_subroundoff)))**2.) endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & @@ -775,21 +785,24 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & else Leady = 0. endif - !LmixScale = 0. - !if (CS%aDeform*Ldeform > 0.) LmixScale = LmixScale + 1./(CS%aDeform*Ldeform) - !if (CS%aFrict *Lfrict > 0.) LmixScale = LmixScale + 1./(CS%aFrict *Lfrict) - !if (CS%aRhines*Lrhines > 0.) LmixScale = LmixScale + 1./(CS%aRhines*Lrhines) - !if (CS%aEady *Leady > 0.) LmixScale = LmixScale + 1./(CS%aEady *Leady) - !if (CS%aGrid *Lgrid > 0.) LmixScale = LmixScale + 1./(CS%aGrid *Lgrid) - !if (CS%Lfixed > 0.) LmixScale = LmixScale + 1./CS%Lfixed - !if (LmixScale > 0.) LmixScale = 1. / LmixScale - LmixScale = 1.e7 - if (CS%aDeform*Ldeform > 0.) LmixScale = min(LmixScale,CS%aDeform*Ldeform) - if (CS%aFrict *Lfrict > 0.) LmixScale = min(LmixScale,CS%aFrict *Lfrict) - if (CS%aRhines*Lrhines > 0.) LmixScale = min(LmixScale,CS%aRhines*Lrhines) - if (CS%aEady *Leady > 0.) LmixScale = min(LmixScale,CS%aEady *Leady) - if (CS%aGrid *Lgrid > 0.) LmixScale = min(LmixScale,CS%aGrid *Lgrid) - if (CS%Lfixed > 0.) LmixScale = min(LmixScale,CS%Lfixed) + if (CS%use_min_lscale) then + LmixScale = 1.e7 + if (CS%aDeform*Ldeform > 0.) LmixScale = min(LmixScale,CS%aDeform*Ldeform) + if (CS%aFrict *Lfrict > 0.) LmixScale = min(LmixScale,CS%aFrict *Lfrict) + if (CS%aRhines*Lrhines > 0.) LmixScale = min(LmixScale,CS%aRhines*Lrhines) + if (CS%aEady *Leady > 0.) LmixScale = min(LmixScale,CS%aEady *Leady) + if (CS%aGrid *Lgrid > 0.) LmixScale = min(LmixScale,CS%aGrid *Lgrid) + if (CS%Lfixed > 0.) LmixScale = min(LmixScale,CS%Lfixed) + else + LmixScale = 0. + if (CS%aDeform*Ldeform > 0.) LmixScale = LmixScale + 1./(CS%aDeform*Ldeform) + if (CS%aFrict *Lfrict > 0.) LmixScale = LmixScale + 1./(CS%aFrict *Lfrict) + if (CS%aRhines*Lrhines > 0.) LmixScale = LmixScale + 1./(CS%aRhines*Lrhines) + if (CS%aEady *Leady > 0.) LmixScale = LmixScale + 1./(CS%aEady *Leady) + if (CS%aGrid *Lgrid > 0.) LmixScale = LmixScale + 1./(CS%aGrid *Lgrid) + if (CS%Lfixed > 0.) LmixScale = LmixScale + 1./CS%Lfixed + if (LmixScale > 0.) LmixScale = 1. / LmixScale + endif endif end subroutine MEKE_lengthScales_0d @@ -905,6 +918,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "If true, use the old formula for length scale which is\n"//& "a function of grid spacing and deformation radius.", & default=.false.) + call get_param(param_file, mdl, "MEKE_MIN_LSCALE", CS%use_min_lscale, & + "If true, use a strict minimum of provided length scales\n"//& + "rather than harmonic mean.", & + default=.false.) call get_param(param_file, mdl, "MEKE_RD_MAX_SCALE", CS%Rd_as_max_scale, & "If true, the length scale used by MEKE is the minimum of\n"//& "the deformation radius or grid-spacing. Only used if\n"//& From 5b33d04f7ab8800a2e919bd7fde48979e8d92726 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Sun, 31 Mar 2019 12:17:17 -0500 Subject: [PATCH 013/106] fixed error in comment of frictional work term notice that it needs to be tau_yy = -tau_xx which is used in teh actual implementation --- 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 b38f6f666e..dd088d495b 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -865,7 +865,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if (find_FrictWork) then ; do j=js,je ; do i=is,ie - ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) + ! Diagnose str_xx*d_x u + str_yy*d_y v + str_xy*(d_y u + d_x v) FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & From 67a4d7ce9ef8b531a816302d8c187a3332e79001 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Sun, 31 Mar 2019 12:35:43 -0500 Subject: [PATCH 014/106] Fixed error in documentation of frictional work term --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index f92cf94bf8..6c06f5ba6b 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1196,7 +1196,7 @@ end subroutine MEKE_end !! \f$ \gamma_\eta \in [0,1] \f$. !! !! The "frictional" source term -!! \f[ \dot{E}_{v} = \left< u \cdot \tau_h \right> \f] +!! \f[ \dot{E}_{v} = \left< \partial_i u_j \tau_{ij} \right> \f] !! equals the mean kinetic energy removed by lateral viscous fluxes, and !! is excluded/included in the MEKE budget by the efficiency parameter !! \f$ \gamma_v \in [0,1] \f$. From 1175747e7f445abb8fc9cb000eea56b02783cc86 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 19 Apr 2019 14:57:05 -0400 Subject: [PATCH 015/106] +Remove unneeded MOM6 coupler_types.F90 files With the xanadu release of FMS, the coupler_types module within FMS has finally been properly scoped without adding unnecssary dependencies. The coupler_types.F90 files in the MOM6 config_src/solo_driver directories are no longer needed. In addition, the routines inside coupler_util.F90 files have not been used anywhere in MOM6 for some time, their functionality being provided via interfaces inside the coupler_types_mod. These 5 files have now been removed. All answers are bitwise identical. --- config_src/coupled_driver/coupler_util.F90 | 137 - config_src/ice_solo_driver/coupler_types.F90 | 3294 ----------------- config_src/ice_solo_driver/coupler_util.F90 | 144 - config_src/solo_driver/coupler_types.F90 | 3310 ------------------ config_src/solo_driver/coupler_util.F90 | 135 - 5 files changed, 7020 deletions(-) delete mode 100644 config_src/coupled_driver/coupler_util.F90 delete mode 100644 config_src/ice_solo_driver/coupler_types.F90 delete mode 100644 config_src/ice_solo_driver/coupler_util.F90 delete mode 100644 config_src/solo_driver/coupler_types.F90 delete mode 100644 config_src/solo_driver/coupler_util.F90 diff --git a/config_src/coupled_driver/coupler_util.F90 b/config_src/coupled_driver/coupler_util.F90 deleted file mode 100644 index 2c72c56cce..0000000000 --- a/config_src/coupled_driver/coupler_util.F90 +++ /dev/null @@ -1,137 +0,0 @@ -!> Provides a couple of interfaces to allow more transparent and -!! robust extraction of the various fields in the coupler types. -module coupler_util - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha -use coupler_types_mod, only : ind_csurf - -implicit none ; private - -public :: extract_coupler_values, set_coupler_values -public :: ind_flux, ind_alpha, ind_csurf - -contains - -!> Extract an array of values in a coupler bc type -subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & - is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - !! permit sign convention or unit conversion. - ! Local variables - real, pointer, dimension(:,:) :: Array_in - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_in => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_out,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_out,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_out,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_out,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_in,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - if (size(Array_in,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - i_offset = lbound(Array_in,1) - is0 - j_offset = lbound(Array_in,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - array_out(i,j) = conv * Array_in(i+i_offset,j+j_offset) - enddo ; enddo - -end subroutine extract_coupler_values - -!> Set an array of values in a coupler bc type -subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & - is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC. - type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - !! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - !! permit sign convention or unit conversion. - ! Local variables - real, pointer, dimension(:,:) :: Array_out - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_out => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_in,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_in,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_in,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_in,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_out,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - if (size(Array_out,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - i_offset = lbound(Array_out,1) - is0 - j_offset = lbound(Array_out,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - Array_out(i+i_offset,j+j_offset) = conv * array_in(i,j) - enddo ; enddo - -end subroutine set_coupler_values - -end module coupler_util diff --git a/config_src/ice_solo_driver/coupler_types.F90 b/config_src/ice_solo_driver/coupler_types.F90 deleted file mode 100644 index 99a74e085c..0000000000 --- a/config_src/ice_solo_driver/coupler_types.F90 +++ /dev/null @@ -1,3294 +0,0 @@ -module coupler_types_mod - -! This file is part of MOM6. See LICENSE.md for the license. - -! This module contains the coupler-type declarations and methods for use in -! ocean-only configurations of MOM6. It is intended that the version of -! coupler_types_mod that is avialable from FMS will conform to this version with -! the FMS city release after warsaw. - -use fms_io_mod, only: restart_file_type, register_restart_field -use fms_io_mod, only: query_initialized, restore_state -use time_manager_mod, only: time_type -use diag_manager_mod, only: register_diag_field, send_data -use data_override_mod, only: data_override -use mpp_domains_mod, only: domain2D, mpp_redistribute -use mpp_mod, only: stdout, mpp_error, FATAL, mpp_chksum - -implicit none ; private - -public coupler_type_copy, coupler_type_spawn, coupler_type_set_diags -public coupler_type_write_chksums, coupler_type_send_data, coupler_type_data_override -public coupler_type_register_restarts, coupler_type_restore_state -public coupler_type_increment_data, coupler_type_rescale_data -public coupler_type_copy_data, coupler_type_redistribute_data -public coupler_type_destructor, coupler_type_initialized -public coupler_type_extract_data, coupler_type_set_data - -public coupler_type_copy_1d_2d -public coupler_type_copy_1d_3d - -! -! 3-d fields -! -type, public :: coupler_3d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_3d_values_type - -type, public :: coupler_3d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_3d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_3d_field_type - -type, public :: coupler_3d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type - integer :: ks, ke !< The k-direction index ranges for this type -end type coupler_3d_bc_type - -! -! 2-d fields -! -type, public :: coupler_2d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_2d_values_type - -type, public :: coupler_2d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_2d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_2d_field_type - -type, public :: coupler_2d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type -end type coupler_2d_bc_type - -! -! 1-d fields -! -type, public :: coupler_1d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, dimension(:) :: values => NULL() !< The pointer to the array of values - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_1d_values_type - -type, public :: coupler_1d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_1d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_1d_field_type - -type, public :: coupler_1d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized -end type coupler_1d_bc_type - -!---------------------------------------------------------------------- -! The following public parameters can help in selecting the sub-elements of a -! coupler type. There are duplicate values because different boundary -! conditions have different sub-elements. -integer, parameter, public :: ind_pcair = 1 !< The index of the atmospheric concentration -integer, parameter, public :: ind_u10 = 2 !< The index of the 10 m wind speed -integer, parameter, public :: ind_psurf = 3 !< The index of the surface atmospheric pressure -integer, parameter, public :: ind_alpha = 1 !< The index of the solubility array for a tracer -integer, parameter, public :: ind_csurf = 2 !< The index of the ocean surface concentration -integer, parameter, public :: ind_sc_no = 3 !< The index for the Schmidt number for a tracer flux -integer, parameter, public :: ind_flux = 1 !< The index for the tracer flux -integer, parameter, public :: ind_deltap= 2 !< The index for ocean-air gas partial pressure change -integer, parameter, public :: ind_kw = 3 !< The index for the piston velocity -integer, parameter, public :: ind_deposition = 1 !< The index for the atmospheric deposition flux -integer, parameter, public :: ind_runoff = 1 !< The index for a runoff flux - -!---------------------------------------------------------------------- -! Interface definitions for overloaded routines -!---------------------------------------------------------------------- - -!> This is the interface to spawn one coupler_bc_type into another and then -!! register diagnostics associated with the new type. -interface coupler_type_copy - module procedure coupler_type_copy_1d_2d, coupler_type_copy_1d_3d - module procedure coupler_type_copy_2d_2d, coupler_type_copy_2d_3d - module procedure coupler_type_copy_3d_2d, coupler_type_copy_3d_3d -end interface coupler_type_copy - -!> This is the interface to spawn one coupler_bc_type into another. -interface coupler_type_spawn - module procedure CT_spawn_1d_2d, CT_spawn_2d_2d, CT_spawn_3d_2d - module procedure CT_spawn_1d_3d, CT_spawn_2d_3d, CT_spawn_3d_3d -end interface coupler_type_spawn - -!> This is the interface to copy the field data from one coupler_bc_type -!! to another of the same rank, size and decomposition. -interface coupler_type_copy_data - module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d -end interface coupler_type_copy_data - -!> This is the interface to redistribute the field data from one coupler_bc_type -!! to another of the same rank and global size, but a different decomposition. -interface coupler_type_redistribute_data - module procedure CT_redistribute_data_2d, CT_redistribute_data_3d -end interface coupler_type_redistribute_data - -!> This is the interface to rescale the field data in a coupler_bc_type. -interface coupler_type_rescale_data - module procedure CT_rescale_data_2d, CT_rescale_data_3d -end interface coupler_type_rescale_data - -!> This is the interface to increment the field data from one coupler_bc_type -!! with the data from another. Both must have the same horizontal size and -!! decomposition, but a 2d type may be incremented by a 2d or 3d type -interface coupler_type_increment_data - module procedure CT_increment_data_2d_2d, CT_increment_data_3d_3d, CT_increment_data_2d_3d -end interface coupler_type_increment_data - -!> This is the interface to extract a field in a coupler_bc_type into an array. -interface coupler_type_extract_data - module procedure CT_extract_data_2d, CT_extract_data_3d, CT_extract_data_3d_2d -end interface coupler_type_extract_data - -!> This is the interface to set a field in a coupler_bc_type from an array. -interface coupler_type_set_data - module procedure CT_set_data_2d, CT_set_data_3d, CT_set_data_2d_3d -end interface coupler_type_set_data - -!> This is the interface to set diagnostics for the arrays in a coupler_bc_type. -interface coupler_type_set_diags - module procedure CT_set_diags_2d, CT_set_diags_3d -end interface coupler_type_set_diags - -!> This is the interface to write out checksums for the elements of a coupler_bc_type. -interface coupler_type_write_chksums - module procedure CT_write_chksums_2d, CT_write_chksums_3d -end interface coupler_type_write_chksums - -!> This is the interface to write out diagnostics of the arrays in a coupler_bc_type. -interface coupler_type_send_data - module procedure CT_send_data_2d, CT_send_data_3d -end interface coupler_type_send_data - -!> This is the interface to override the values of the arrays in a coupler_bc_type. -interface coupler_type_data_override - module procedure CT_data_override_2d, CT_data_override_3d -end interface coupler_type_data_override - -!> This is the interface to register the fields in a coupler_bc_type to be saved -!! in restart files. -interface coupler_type_register_restarts - module procedure CT_register_restarts_2d, CT_register_restarts_3d - module procedure CT_register_restarts_to_file_2d, CT_register_restarts_to_file_3d -end interface coupler_type_register_restarts - -!> This is the interface to read in the fields in a coupler_bc_type that have -!! been saved in restart files. -interface coupler_type_restore_state - module procedure CT_restore_state_2d, CT_restore_state_3d -end interface coupler_type_restore_state - -!> This function interface indicates whether a coupler_bc_type has been initialized. -interface coupler_type_initialized - module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d -end interface coupler_type_initialized - -!> This is the interface to deallocate any data associated with a coupler_bc_type. -interface coupler_type_destructor - module procedure CT_destructor_1d, CT_destructor_2d, CT_destructor_3d -end interface coupler_type_destructor - -contains - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_3d - - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 2-D version for generic coupler_type_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var_out, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_3d - - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_3d_bc_type into another. Both types must have the same array sizes. -subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_3d - -!> This subroutine does a direct copy of the data in all elements of a -!! coupler_2d_bc_type into a coupler_3d_bc_type. Both types must have the same -!! array sizes for their first two dimensions, while the extent of the 3rd dimension -!! that is being filled may be specified via optional arguments. -subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice, & - ind3_start, ind3_end) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd - !! index of the 3d type to fill in. - integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd - !! index of the 3d type to fill in. - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, ks, ke - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the output structure.") - endif - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - ks = var%ks ; if (present(ind3_start)) ks = max(ks, ind3_start) - ke = var%ke ; if (present(ind3_end)) ke = max(ke, ind3_end) - do k=ks,ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d_3d - - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:) :: null_ptr2D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_2d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_2d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_2d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr2D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr2D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_2d - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:,:) :: null_ptr3D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_3d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_3d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_3d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr3D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr3D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_3d - - -!> This subroutine rescales the fields in the elements of a coupler_2d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = 0.0 - enddo ; enddo - else - var%bc(n)%field(m)%values(:,:) = 0.0 - endif - else - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = scale * var%bc(n)%field(m)%values(i,j) - enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_2d - -!> This subroutine rescales the fields in the elements of a coupler_3d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, k, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = 0.0 - enddo ; enddo ; enddo - else - var%bc(n)%field(m)%values(:,:,:) = 0.0 - endif - else - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = scale * var%bc(n)%field(m)%values(i,j,k) - enddo ; enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_3d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_2d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_3d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = sc_prev * var%bc(n)%field(m)%values(i,j,k) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_3d_3d - -!> This subroutine does increments the data in the elements of a coupler_2d_bc_type -!! with the weighed average of the elements of a coupler_3d_bc_type. Both must have -!! the same horizontal array sizes and the normalized weight array must match the -!! array sizes of the coupler_3d_bc_type. -subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to - !! increment the 2d-data. There is no renormalization, - !! so if the weights do not sum to 1 in the 3rd dimension - !! there may be adverse consequences! - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo - integer :: io1, jo1, iow, jow, kow ! Offsets to account for different index conventions. - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((1+var_in%ke-var_in%ks) /= size(weights,3)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a k-direction size mismatch with the weights array.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the output structure.") - - if ((1+var%iec-var%isc) == size(weights,1)) then - iow = 1 - var%isc - elseif ((1+var%ied-var%isd) == size(weights,1)) then - iow = 1 - var%isd - elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then - iow = 1 + (var_in%isc - var_in%isd) - var%isc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& - "of a computational or data domain.") - endif - if ((1+var%jec-var%jsc) == size(weights,2)) then - jow = 1 - var%jsc - elseif ((1+var%jed-var%jsd) == size(weights,2)) then - jow = 1 - var%jsd - elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then - jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& - "of a computational or data domain.") - endif - - io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var_in%ks,var_in%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - (scale * weights(i+iow,j+jow,k+kow)) * var_in%bc(n)%field(m)%values(i+io1,j+io1,k) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_3d - - -!> This subroutine extracts a single 2-d field from a coupler_2d_bc_type into -!! a two-dimensional array. -subroutine CT_extract_data_2d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j) - enddo ; enddo - -end subroutine CT_extract_data_2d - -!> This subroutine extracts a single k-level of a 3-d field from a coupler_3d_bc_type -!! into a two-dimensional array. -subroutine CT_extract_data_3d_2d(var_in, bc_index, field_index, k_in, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_in !< The k-index to extract - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if ((k_in > var_in%ke) .or. (k_in < var_in%ks)) then - write (error_msg, *) trim(error_header), ' The extracted k-index of ', k_in, & - ' is outside of the valid range of ', var_in%ks, ' to ', var_in%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k_in) - enddo ; enddo - -end subroutine CT_extract_data_3d_2d - -!> This subroutine extracts a single 3-d field from a coupler_3d_bc_type into -!! a three-dimensional array. -subroutine CT_extract_data_3d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) then - array_out(:,:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if (size(array_out,3) /= 1 + var_in%ke - var_in%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_out,3), ' does not match the data of size ', & - (1 + var_in%ke - var_in%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var_in%ks - - do k=var_in%ks,var_in%ke ; do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off,k+k_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k) - enddo ; enddo ; enddo - -end subroutine CT_extract_data_3d - - -!> This subroutine sets a single 2-d field in a coupler_3d_bc_type from -!! a two-dimensional array. -subroutine CT_set_data_2d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d - -!> This subroutine sets a one k-level of a single 3-d field in a -!! coupler_3d_bc_type from a two-dimensional array. -subroutine CT_set_data_2d_3d(array_in, bc_index, field_index, k_out, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_out !< The k-index to set - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if ((k_out > var%ke) .or. (k_out < var%ks)) then - write (error_msg, *) trim(error_header), ' The seted k-index of ', k_out, & - ' is outside of the valid range of ', var%ks, ' to ', var%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k_out) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d_3d - -!> This subroutine sets a single 3-d field in a coupler_3d_bc_type from -!! a three-dimensional array. -subroutine CT_set_data_3d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if (size(array_in,3) /= 1 + var%ke - var%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_in,3), ' does not match the data of size ', & - (1 + var%ke - var%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var%ks - - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k) = scale * array_in(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - -end subroutine CT_set_data_3d - - -!> This routine registers the diagnostics of a coupler_2d_bc_type. -subroutine CT_set_diags_2d(var, diag_name, axes, time) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 2) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 2 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:2), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_2d - -!> This routine registers the diagnostics of a coupler_3d_bc_type. -subroutine CT_set_diags_3d(var, diag_name, axes, time) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 3) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 3 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:3), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_3d - - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_2d(var, Time) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_2d - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_3d(var, Time) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_3d - - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_2d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_2d - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_2d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_2d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_3d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m, id_restart - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_3d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_3d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_3d - - -!> This subroutine reads in the fields in a coupler_2d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_2d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_2d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_2d - -!> This subroutine reads in the fields in a coupler_3d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_3d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_3d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_3d - - -!> This subroutine potentially overrides the values in a coupler_2d_bc_type -subroutine CT_data_override_2d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_2d - -!> This subroutine potentially overrides the values in a coupler_3d_bc_type -subroutine CT_data_override_3d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_3d - - -!> This subroutine writes out checksums for the elements of a coupler_2d_bc_type -subroutine CT_write_chksums_2d(var, outunit, name_lead) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') trim(var_name), & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec) ) - enddo ; enddo - -end subroutine CT_write_chksums_2d - -!> This subroutine writes out checksums for the elements of a coupler_3d_bc_type -subroutine CT_write_chksums_3d(var, outunit, name_lead) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') var_name, & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec,:) ) - enddo ; enddo - -end subroutine CT_write_chksums_3d - - -!> This function indicates whether a coupler_1d_bc_type has been initialized. -function CT_initialized_1d(var) - type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_1d !< The return value, indicating whether this type has been initialized - - CT_initialized_1d = var%set -end function CT_initialized_1d - -!> This function indicates whether a coupler_2d_bc_type has been initialized. -function CT_initialized_2d(var) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_2d !< The return value, indicating whether this type has been initialized - - CT_initialized_2d = var%set -end function CT_initialized_2d - -!> This function indicates whether a coupler_3d_bc_type has been initialized. -function CT_initialized_3d(var) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_3d !< The return value, indicating whether this type has been initialized - - CT_initialized_3d = var%set -end function CT_initialized_3d - - -!> This subroutine deallocates all data associated with a coupler_1d_bc_type -subroutine CT_destructor_1d(var) - type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_1d - -!> This subroutine deallocates all data associated with a coupler_2d_bc_type -subroutine CT_destructor_2d(var) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_2d - - -!> This subroutine deallocates all data associated with a coupler_3d_bc_type -subroutine CT_destructor_3d(var) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_3d - -end module coupler_types_mod diff --git a/config_src/ice_solo_driver/coupler_util.F90 b/config_src/ice_solo_driver/coupler_util.F90 deleted file mode 100644 index dde67c2976..0000000000 --- a/config_src/ice_solo_driver/coupler_util.F90 +++ /dev/null @@ -1,144 +0,0 @@ -module coupler_util - -! This file is part of MOM6. See LICENSE.md for the license. - -! This code provides a couple of interfaces to allow more transparent and -! robust extraction of the various fields in the coupler types. -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha -use coupler_types_mod, only : ind_csurf - -implicit none ; private - -public :: extract_coupler_values, set_coupler_values -public :: ind_flux, ind_alpha, ind_csurf - -contains - -subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & - is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc - integer, intent(in) :: BC_index, BC_element - real, dimension(:,:), intent(out) :: array_out - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: BC_struc - The type from which the data is being extracted. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (out) array_out - The array being filled with the input values. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - - real, pointer, dimension(:,:) :: Array_in - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_in => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_out,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_out,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_out,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_out,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_in,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - if (size(Array_in,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - i_offset = lbound(Array_in,1) - is0 - j_offset = lbound(Array_in,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - array_out(i,j) = conv * Array_in(i+i_offset,j+j_offset) - enddo ; enddo - -end subroutine extract_coupler_values - -subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & - is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in - type(coupler_2d_bc_type), intent(inout) :: BC_struc - integer, intent(in) :: BC_index, BC_element - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: array_in - The array containing the values to load into the BC. -! (out) BC_struc - The type into which the data is being loaded. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - - real, pointer, dimension(:,:) :: Array_out - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_out => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_in,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_in,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_in,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_in,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_out,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - if (size(Array_out,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - i_offset = lbound(Array_out,1) - is0 - j_offset = lbound(Array_out,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - Array_out(i+i_offset,j+j_offset) = conv * array_in(i,j) - enddo ; enddo - -end subroutine set_coupler_values - -end module coupler_util diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 deleted file mode 100644 index 10d22a8eff..0000000000 --- a/config_src/solo_driver/coupler_types.F90 +++ /dev/null @@ -1,3310 +0,0 @@ -!> This module contains the coupler-type declarations and methods for use in -!! ocean-only configurations of MOM6. -!! -!! It is intended that the version of coupler_types_mod that is avialable from -!! FMS will conform to this version with the FMS city release after warsaw. - -module coupler_types_mod - -! This file is part of MOM6. See LICENSE.md for the license. - -use fms_io_mod, only: restart_file_type, register_restart_field -use fms_io_mod, only: query_initialized, restore_state -use time_manager_mod, only: time_type -use diag_manager_mod, only: register_diag_field, send_data -use data_override_mod, only: data_override -use mpp_domains_mod, only: domain2D, mpp_redistribute -use mpp_mod, only: stdout, mpp_error, FATAL, mpp_chksum - -implicit none ; private - -public coupler_type_copy, coupler_type_spawn, coupler_type_set_diags -public coupler_type_write_chksums, coupler_type_send_data, coupler_type_data_override -public coupler_type_register_restarts, coupler_type_restore_state -public coupler_type_increment_data, coupler_type_rescale_data -public coupler_type_copy_data, coupler_type_redistribute_data -public coupler_type_destructor, coupler_type_initialized -public coupler_type_extract_data, coupler_type_set_data - -public coupler_type_copy_1d_2d -public coupler_type_copy_1d_3d - - -! -! 3-d fields -! -!> A type with a 3-d array of values and metadata -type, public :: coupler_3d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_3d_values_type - -!> A field with one or more related 3-d variables and collective metadata -type, public :: coupler_3d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_3d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_3d_field_type - -!> A collection of 3-D boundary conditions for exchange between components -type, public :: coupler_3d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - !>@{ The i- and j-direction data and computational domain index ranges for this type - integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type - !!@} - integer :: ks !< The k-direction start index for this type - integer :: ke !< The k-direction end index for this type -end type coupler_3d_bc_type - -! -! 2-d fields -! -!> A type with a 2-d array of values and metadata -type, public :: coupler_2d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_2d_values_type - -!> A field with one or more related 2-d variables and collective metadata -type, public :: coupler_2d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_2d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_2d_field_type - -!> A collection of 2-D boundary conditions for exchange between components -type, public :: coupler_2d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - !>@{ The i- and j-direction data and computational domain index ranges for this type - integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type - !!@} -end type coupler_2d_bc_type - -! -! 1-d fields -! -!> A type with a 1-d array of values and metadata -type, public :: coupler_1d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, dimension(:) :: values => NULL() !< The pointer to the array of values - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_1d_values_type - -!> A field with one or more related 1-d variables and collective metadata -type, public :: coupler_1d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_1d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_1d_field_type - -!> A collection of 1-D boundary conditions for exchange between components -type, public :: coupler_1d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized -end type coupler_1d_bc_type - -!---------------------------------------------------------------------- -! The following public parameters can help in selecting the sub-elements of a -! coupler type. There are duplicate values because different boundary -! conditions have different sub-elements. -integer, parameter, public :: ind_pcair = 1 !< The index of the atmospheric concentration -integer, parameter, public :: ind_u10 = 2 !< The index of the 10 m wind speed -integer, parameter, public :: ind_psurf = 3 !< The index of the surface atmospheric pressure -integer, parameter, public :: ind_alpha = 1 !< The index of the solubility array for a tracer -integer, parameter, public :: ind_csurf = 2 !< The index of the ocean surface concentration -integer, parameter, public :: ind_sc_no = 3 !< The index for the Schmidt number for a tracer flux -integer, parameter, public :: ind_flux = 1 !< The index for the tracer flux -integer, parameter, public :: ind_deltap= 2 !< The index for ocean-air gas partial pressure change -integer, parameter, public :: ind_kw = 3 !< The index for the piston velocity -integer, parameter, public :: ind_deposition = 1 !< The index for the atmospheric deposition flux -integer, parameter, public :: ind_runoff = 1 !< The index for a runoff flux - -!---------------------------------------------------------------------- -! Interface definitions for overloaded routines -!---------------------------------------------------------------------- - -!> This is the interface to spawn one coupler_bc_type into another and then -!! register diagnostics associated with the new type. -interface coupler_type_copy - module procedure coupler_type_copy_1d_2d, coupler_type_copy_1d_3d - module procedure coupler_type_copy_2d_2d, coupler_type_copy_2d_3d - module procedure coupler_type_copy_3d_2d, coupler_type_copy_3d_3d -end interface coupler_type_copy - -!> This is the interface to spawn one coupler_bc_type into another. -interface coupler_type_spawn - module procedure CT_spawn_1d_2d, CT_spawn_2d_2d, CT_spawn_3d_2d - module procedure CT_spawn_1d_3d, CT_spawn_2d_3d, CT_spawn_3d_3d -end interface coupler_type_spawn - -!> This is the interface to copy the field data from one coupler_bc_type -!! to another of the same rank, size and decomposition. -interface coupler_type_copy_data - module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d -end interface coupler_type_copy_data - -!> This is the interface to redistribute the field data from one coupler_bc_type -!! to another of the same rank and global size, but a different decomposition. -interface coupler_type_redistribute_data - module procedure CT_redistribute_data_2d, CT_redistribute_data_3d -end interface coupler_type_redistribute_data - -!> This is the interface to rescale the field data in a coupler_bc_type. -interface coupler_type_rescale_data - module procedure CT_rescale_data_2d, CT_rescale_data_3d -end interface coupler_type_rescale_data - -!> This is the interface to increment the field data from one coupler_bc_type -!! with the data from another. Both must have the same horizontal size and -!! decomposition, but a 2d type may be incremented by a 2d or 3d type -interface coupler_type_increment_data - module procedure CT_increment_data_2d_2d, CT_increment_data_3d_3d, CT_increment_data_2d_3d -end interface coupler_type_increment_data - -!> This is the interface to extract a field in a coupler_bc_type into an array. -interface coupler_type_extract_data - module procedure CT_extract_data_2d, CT_extract_data_3d, CT_extract_data_3d_2d -end interface coupler_type_extract_data - -!> This is the interface to set a field in a coupler_bc_type from an array. -interface coupler_type_set_data - module procedure CT_set_data_2d, CT_set_data_3d, CT_set_data_2d_3d -end interface coupler_type_set_data - -!> This is the interface to set diagnostics for the arrays in a coupler_bc_type. -interface coupler_type_set_diags - module procedure CT_set_diags_2d, CT_set_diags_3d -end interface coupler_type_set_diags - -!> This is the interface to write out checksums for the elements of a coupler_bc_type. -interface coupler_type_write_chksums - module procedure CT_write_chksums_2d, CT_write_chksums_3d -end interface coupler_type_write_chksums - -!> This is the interface to write out diagnostics of the arrays in a coupler_bc_type. -interface coupler_type_send_data - module procedure CT_send_data_2d, CT_send_data_3d -end interface coupler_type_send_data - -!> This is the interface to override the values of the arrays in a coupler_bc_type. -interface coupler_type_data_override - module procedure CT_data_override_2d, CT_data_override_3d -end interface coupler_type_data_override - -!> This is the interface to register the fields in a coupler_bc_type to be saved -!! in restart files. -interface coupler_type_register_restarts - module procedure CT_register_restarts_2d, CT_register_restarts_3d - module procedure CT_register_restarts_to_file_2d, CT_register_restarts_to_file_3d -end interface coupler_type_register_restarts - -!> This is the interface to read in the fields in a coupler_bc_type that have -!! been saved in restart files. -interface coupler_type_restore_state - module procedure CT_restore_state_2d, CT_restore_state_3d -end interface coupler_type_restore_state - -!> This function interface indicates whether a coupler_bc_type has been initialized. -interface coupler_type_initialized - module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d -end interface coupler_type_initialized - -!> This is the interface to deallocate any data associated with a coupler_bc_type. -interface coupler_type_destructor - module procedure CT_destructor_1d, CT_destructor_2d, CT_destructor_3d -end interface coupler_type_destructor - -contains - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_3d - - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 2-D version for generic coupler_type_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var_out, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_3d - - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_3d_bc_type into another. Both types must have the same array sizes. -subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_3d - -!> This subroutine does a direct copy of the data in all elements of a -!! coupler_2d_bc_type into a coupler_3d_bc_type. Both types must have the same -!! array sizes for their first two dimensions, while the extent of the 3rd dimension -!! that is being filled may be specified via optional arguments. -subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice, & - ind3_start, ind3_end) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd - !! index of the 3d type to fill in. - integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd - !! index of the 3d type to fill in. - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, ks, ke - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the output structure.") - endif - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - ks = var%ks ; if (present(ind3_start)) ks = max(ks, ind3_start) - ke = var%ke ; if (present(ind3_end)) ke = max(ke, ind3_end) - do k=ks,ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d_3d - - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:) :: null_ptr2D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_2d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_2d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_2d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr2D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr2D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_2d - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:,:) :: null_ptr3D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_3d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_3d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_3d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr3D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr3D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_3d - - -!> This subroutine rescales the fields in the elements of a coupler_2d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = 0.0 - enddo ; enddo - else - var%bc(n)%field(m)%values(:,:) = 0.0 - endif - else - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = scale * var%bc(n)%field(m)%values(i,j) - enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_2d - -!> This subroutine rescales the fields in the elements of a coupler_3d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, k, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = 0.0 - enddo ; enddo ; enddo - else - var%bc(n)%field(m)%values(:,:,:) = 0.0 - endif - else - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = scale * var%bc(n)%field(m)%values(i,j,k) - enddo ; enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_3d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_2d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_3d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = sc_prev * var%bc(n)%field(m)%values(i,j,k) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_3d_3d - -!> This subroutine does increments the data in the elements of a coupler_2d_bc_type -!! with the weighed average of the elements of a coupler_3d_bc_type. Both must have -!! the same horizontal array sizes and the normalized weight array must match the -!! array sizes of the coupler_3d_bc_type. -subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to - !! increment the 2d-data. There is no renormalization, - !! so if the weights do not sum to 1 in the 3rd dimension - !! there may be adverse consequences! - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo - integer :: io1, jo1, iow, jow, kow ! Offsets to account for different index conventions. - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((1+var_in%ke-var_in%ks) /= size(weights,3)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a k-direction size mismatch with the weights array.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the output structure.") - - if ((1+var%iec-var%isc) == size(weights,1)) then - iow = 1 - var%isc - elseif ((1+var%ied-var%isd) == size(weights,1)) then - iow = 1 - var%isd - elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then - iow = 1 + (var_in%isc - var_in%isd) - var%isc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& - "of a computational or data domain.") - endif - if ((1+var%jec-var%jsc) == size(weights,2)) then - jow = 1 - var%jsc - elseif ((1+var%jed-var%jsd) == size(weights,2)) then - jow = 1 - var%jsd - elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then - jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& - "of a computational or data domain.") - endif - - io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var_in%ks,var_in%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - (scale * weights(i+iow,j+jow,k+kow)) * var_in%bc(n)%field(m)%values(i+io1,j+io1,k) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_3d - - -!> This subroutine extracts a single 2-d field from a coupler_2d_bc_type into -!! a two-dimensional array. -subroutine CT_extract_data_2d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j) - enddo ; enddo - -end subroutine CT_extract_data_2d - -!> This subroutine extracts a single k-level of a 3-d field from a coupler_3d_bc_type -!! into a two-dimensional array. -subroutine CT_extract_data_3d_2d(var_in, bc_index, field_index, k_in, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_in !< The k-index to extract - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if ((k_in > var_in%ke) .or. (k_in < var_in%ks)) then - write (error_msg, *) trim(error_header), ' The extracted k-index of ', k_in, & - ' is outside of the valid range of ', var_in%ks, ' to ', var_in%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k_in) - enddo ; enddo - -end subroutine CT_extract_data_3d_2d - -!> This subroutine extracts a single 3-d field from a coupler_3d_bc_type into -!! a three-dimensional array. -subroutine CT_extract_data_3d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) then - array_out(:,:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if (size(array_out,3) /= 1 + var_in%ke - var_in%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_out,3), ' does not match the data of size ', & - (1 + var_in%ke - var_in%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var_in%ks - - do k=var_in%ks,var_in%ke ; do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off,k+k_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k) - enddo ; enddo ; enddo - -end subroutine CT_extract_data_3d - - -!> This subroutine sets a single 2-d field in a coupler_3d_bc_type from -!! a two-dimensional array. -subroutine CT_set_data_2d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d - -!> This subroutine sets a one k-level of a single 3-d field in a -!! coupler_3d_bc_type from a two-dimensional array. -subroutine CT_set_data_2d_3d(array_in, bc_index, field_index, k_out, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_out !< The k-index to set - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if ((k_out > var%ke) .or. (k_out < var%ks)) then - write (error_msg, *) trim(error_header), ' The seted k-index of ', k_out, & - ' is outside of the valid range of ', var%ks, ' to ', var%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k_out) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d_3d - -!> This subroutine sets a single 3-d field in a coupler_3d_bc_type from -!! a three-dimensional array. -subroutine CT_set_data_3d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if (size(array_in,3) /= 1 + var%ke - var%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_in,3), ' does not match the data of size ', & - (1 + var%ke - var%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var%ks - - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k) = scale * array_in(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - -end subroutine CT_set_data_3d - - -!> This routine registers the diagnostics of a coupler_2d_bc_type. -subroutine CT_set_diags_2d(var, diag_name, axes, time) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 2) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 2 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:2), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_2d - -!> This routine registers the diagnostics of a coupler_3d_bc_type. -subroutine CT_set_diags_3d(var, diag_name, axes, time) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 3) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 3 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:3), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_3d - - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_2d(var, Time) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_2d - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_3d(var, Time) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_3d - - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_2d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_2d - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_2d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_2d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_3d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m, id_restart - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_3d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_3d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_3d - - -!> This subroutine reads in the fields in a coupler_2d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_2d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_2d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_2d - -!> This subroutine reads in the fields in a coupler_3d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_3d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_3d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_3d - - -!> This subroutine potentially overrides the values in a coupler_2d_bc_type -subroutine CT_data_override_2d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_2d - -!> This subroutine potentially overrides the values in a coupler_3d_bc_type -subroutine CT_data_override_3d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_3d - - -!> This subroutine writes out checksums for the elements of a coupler_2d_bc_type -subroutine CT_write_chksums_2d(var, outunit, name_lead) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') trim(var_name), & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec) ) - enddo ; enddo - -end subroutine CT_write_chksums_2d - -!> This subroutine writes out checksums for the elements of a coupler_3d_bc_type -subroutine CT_write_chksums_3d(var, outunit, name_lead) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') var_name, & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec,:) ) - enddo ; enddo - -end subroutine CT_write_chksums_3d - - -!> This function indicates whether a coupler_1d_bc_type has been initialized. -function CT_initialized_1d(var) - type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_1d !< The return value, indicating whether this type has been initialized - - CT_initialized_1d = var%set -end function CT_initialized_1d - -!> This function indicates whether a coupler_2d_bc_type has been initialized. -function CT_initialized_2d(var) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_2d !< The return value, indicating whether this type has been initialized - - CT_initialized_2d = var%set -end function CT_initialized_2d - -!> This function indicates whether a coupler_3d_bc_type has been initialized. -function CT_initialized_3d(var) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_3d !< The return value, indicating whether this type has been initialized - - CT_initialized_3d = var%set -end function CT_initialized_3d - - -!> This subroutine deallocates all data associated with a coupler_1d_bc_type -subroutine CT_destructor_1d(var) - type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_1d - -!> This subroutine deallocates all data associated with a coupler_2d_bc_type -subroutine CT_destructor_2d(var) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_2d - - -!> This subroutine deallocates all data associated with a coupler_3d_bc_type -subroutine CT_destructor_3d(var) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_3d - -end module coupler_types_mod diff --git a/config_src/solo_driver/coupler_util.F90 b/config_src/solo_driver/coupler_util.F90 deleted file mode 100644 index cc63a9563d..0000000000 --- a/config_src/solo_driver/coupler_util.F90 +++ /dev/null @@ -1,135 +0,0 @@ -!> Provides a couple of interfaces to allow more transparent and -!! robust extraction of the various fields in the coupler types. -module coupler_util - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha -use coupler_types_mod, only : ind_csurf - -implicit none ; private - -public :: extract_coupler_values, set_coupler_values -public :: ind_flux, ind_alpha, ind_csurf - -contains - -!> Extract an array of values in a coupler bc type -subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & - is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - ! Local variables - real, pointer, dimension(:,:) :: Array_in - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_in => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_out,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_out,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_out,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_out,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_in,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - if (size(Array_in,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - i_offset = lbound(Array_in,1) - is0 - j_offset = lbound(Array_in,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - array_out(i,j) = conv * Array_in(i+i_offset,j+j_offset) - enddo ; enddo - -end subroutine extract_coupler_values - -!> Set an array of values in a coupler bc type -subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & - is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC. - type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - !! permit sign convention or unit conversion. - ! Local variables - real, pointer, dimension(:,:) :: Array_out - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_out => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_in,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_in,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_in,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_in,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_out,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - if (size(Array_out,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - i_offset = lbound(Array_out,1) - is0 - j_offset = lbound(Array_out,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - Array_out(i+i_offset,j+j_offset) = conv * array_in(i,j) - enddo ; enddo - -end subroutine set_coupler_values - -end module coupler_util From d1ad0dcedc73d1256dde5cb2293563a34953840b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 10:43:37 -0400 Subject: [PATCH 016/106] Checksum support for Depth_list.nc This patch appends a checksum for the dependencies of the depth and area lists stored in the Depth_list.nc file, which are used to compute diagnostics based on APE. The data in Depth_list.nc depends on the grid fields, and may not be reproducible when such grids are constructed internally using compiled code within the executable. This issue was observed in the 'double_gyre' experiment when a PGI-compiled executable was tested using a Depth_list.nc file generated by a GNU-compiled executable. By appending a checksum for the grid fields used to compute Depth_list.nc, we can ensure that the data is consistent with the experiment grid data. Grid data which is read from external files, such as mosaic or topography fields, are unaffected by this issue. This patch improves the reproducibilty of standard diagnostics, such as total energy, but has no impact on the reproducibility of the internal model dynamics, which does not depend on Depth_list.nc. Checksums are computed for the G%bathyT and masked G%areaT grid fields using the FMS mpp_checksum subroutine, which require collective operations, and are stored as hex strings in global attributes of the netCDF file. Strings are used to remain consistent with FMS restart checksums, and to avoid an observed re-casting of 8-byte integers to 4-bytes by the netCDF library. Attribute names are based on the grid variable names. Two flags have been introduced to control this behavior: REQUIRE_DEPTH_LIST_CHECKSUMS (default: True) This flag will abort the run if the Depth_list.nc file is present and checksums are absent from the file. Although this could impose greater restrictions on existing runs, few runs are configured to save the depth list file (READ_DEPTH_LIST) and the default behavior is to reconstruct these lists on every run. UPDATE_DEPTH_LIST_CHECKSUMS (default: False) When REQUIRE_DEPTH_LIST_CHECKSUMS is set to false, this flag will automatically update the checksums of the Depth_list.nc file. While this can affect the reproducibility of APE diagnostics, it will ensure the reproducibility of such diagnostics in subsequent runs. --- src/diagnostics/MOM_sum_output.F90 | 132 +++++++++++++++++++++++++++++ 1 file changed, 132 insertions(+) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index cfc74b47fc..1a6cc58c1f 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -3,6 +3,7 @@ module MOM_sum_output ! This file is part of MOM6. See LICENSE.md for the license. +use iso_fortran_env, only : int64 use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs use MOM_coms, only : reproducing_sum, EFP_to_real, real_to_EFP use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=) @@ -24,6 +25,7 @@ module MOM_sum_output use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type +use mpp_mod, only : mpp_chksum use netcdf @@ -39,6 +41,8 @@ module MOM_sum_output ! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields +character (*), parameter :: depth_chksum_attr = "bathyT_checksum" +character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. @@ -64,6 +68,12 @@ module MOM_sum_output character(len=200) :: depth_list_file !< The name of the depth list file. real :: D_list_min_inc !< The minimum increment [Z ~> m], between the depths of the !! entries in the depth-list file, 0 by default. + logical :: require_depth_list_chksum + !< Require matching checksums in Depth_list.nc when reading + !! the file. + logical :: update_depth_list_chksum + !< Automatically update the Depth_list.nc file if the + !! checksums are missing or do not match current values. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes !! since the last time that write_energy was called [kg]. @@ -226,6 +236,20 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & "The name of the depth list file.", default="Depth_list.nc") if (scan(CS%depth_list_file,'/') == 0) & CS%depth_list_file = trim(slasher(directory))//trim(CS%depth_list_file) + + call get_param(param_file, mdl, "REQUIRE_DEPTH_LIST_CHECKSUMS", & + CS%require_depth_list_chksum, & + desc="Require matching checksums in Depth_list.nc when reading\n" & + // "the file.", & + default=.true. & + ) + if (.not. CS%require_depth_list_chksum) & + call get_param(param_file, mdl, "UPDATE_DEPTH_LIST_CHECKSUMS", & + CS%update_depth_list_chksum, & + desc="Automatically update the Depth_list.nc file if the\n" & + // "checksums are missing or do not match current values.", & + default=.false. & + ) endif allocate(CS%lH(G%ke)) @@ -1203,6 +1227,10 @@ subroutine write_depth_list(G, US, CS, filename, list_size) ! Local variables real, allocatable :: tmp(:) integer :: ncid, dimid(1), Did, Aid, Vid, status, k + 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) if (.not.is_root_pe()) return @@ -1248,6 +1276,15 @@ subroutine write_depth_list(G, US, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) + ! Dependency checksums + status = NF90_PUT_ATT(ncid, NF90_GLOBAL, depth_chksum_attr, depth_chksum) + if (status /= NF90_NOERR) call MOM_error(WARNING, & + filename//" "//depth_chksum_attr//" "//trim(NF90_STRERROR(status))) + + status = NF90_PUT_ATT(ncid, NF90_GLOBAL, area_chksum_attr, area_chksum) + if (status /= NF90_NOERR) call MOM_error(WARNING, & + filename//" "//area_chksum_attr//" "//trim(NF90_STRERROR(status))) + status = NF90_ENDDEF(ncid) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//trim(NF90_STRERROR(status))) @@ -1287,6 +1324,9 @@ subroutine read_depth_list(G, US, CS, filename) real, allocatable :: tmp(:) integer :: ncid, status, varid, list_size, k integer :: ndim, len, var_dim_ids(NF90_MAX_VAR_DIMS) + character(len=16) :: depth_file_chksum, depth_grid_chksum + character(len=16) :: area_file_chksum, area_grid_chksum + integer :: depth_attr_status, area_attr_status mdl = "MOM_sum_output read_depth_list:" @@ -1296,6 +1336,62 @@ subroutine read_depth_list(G, US, CS, filename) " - "//trim(NF90_STRERROR(status))) endif + ! Check bathymetric consistency + depth_attr_status = NF90_GET_ATT(ncid, NF90_GLOBAL, depth_chksum_attr, & + depth_file_chksum) + area_attr_status = NF90_GET_ATT(ncid, NF90_GLOBAL, area_chksum_attr, & + area_file_chksum) + + if (any([depth_attr_status, area_attr_status] == NF90_ENOTATT)) then + var_msg = trim(CS%depth_list_file) // " checksums are missing;" + if (CS%require_depth_list_chksum) then + call MOM_error(FATAL, trim(var_msg) // " aborting.") + else if (CS%update_depth_list_chksum) then + call MOM_error(WARNING, trim(var_msg) // " updating file.") + call create_depth_list(G, CS) + call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) + return + else + call MOM_error(WARNING, & + trim(var_msg) // " some diagnostics may not be reproducible." & + ) + end if + else + ! Validate netCDF call + if (depth_attr_status /= NF90_NOERR) then + var_msg = mdl // "Failed to read " // trim(filename) // ":" & + // depth_chksum_attr + call MOM_error(FATAL, trim(var_msg) // " - " & + // NF90_STRERROR(depth_attr_status)) + end if + + if (area_attr_status /= NF90_NOERR) then + var_msg = mdl // "Failed to read " // trim(filename) // ":" & + // area_chksum_attr + call MOM_error(FATAL, trim(var_msg) // " - " & + // NF90_STRERROR(area_attr_status)) + end if + + call get_depth_list_checksums(G, depth_grid_chksum, area_grid_chksum) + + if (depth_grid_chksum /= depth_file_chksum & + .or. area_grid_chksum /= area_file_chksum) then + var_msg = trim(CS%depth_list_file) // " checksums do not match;" + if (CS%require_depth_list_chksum) then + call MOM_error(FATAL, trim(var_msg) // " aborting.") + else if (CS%update_depth_list_chksum) then + call MOM_error(WARNING, trim(var_msg) // " updating file.") + call create_depth_list(G, CS) + call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) + return + else + call MOM_error(WARNING, & + trim(var_msg) // " some diagnostics may not be reproducible." & + ) + end if + end if + endif + var_name = "depth" var_msg = trim(var_name)//" in "//trim(filename)//" - " status = NF90_INQ_VARID(ncid, var_name, varid) @@ -1363,6 +1459,42 @@ subroutine read_depth_list(G, US, CS, filename) end subroutine read_depth_list + +!> Return the checksums required to verify DEPTH_LIST_FILE contents. +!! +!! This function computes checksums for the bathymetry (G%bathyT) and masked +!! area (mask2dT * areaT) fields of the model grid G, which are used to compute +!! the depth list. A difference in checksum indicates that a different method +!! was used to compute the grid data, and that any results using the depth +!! list, such as APE, will not be reproducible. +!! +!! 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) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + character(len=16), intent(out) :: depth_chksum !< Depth checksum hexstring + character(len=16), intent(out) :: area_chksum !< Area checksum hexstring + + integer :: i, j + real, allocatable :: field(:,:) + + allocate(field(G%isc:G%iec, G%jsc:G%jec)) + + ! Depth checksum + do j=G%jsc,G%jec ; do i=G%isc,G%iec + field(i,j) = G%bathyT(i,j) + enddo ; enddo + write(depth_chksum, '(Z16)') mpp_chksum(field(:,:)) + + ! Area checksum + do j=G%jsc,G%jec ; do i=G%isc,G%iec + field(i,j) = G%mask2dT(i,j) * G%areaT(i,j) + enddo ; enddo + write(area_chksum, '(Z16)') mpp_chksum(field(:,:)) + + deallocate(field) +end subroutine get_depth_list_checksums + !> \namespace mom_sum_output !! !! By Robert Hallberg, April 1994 - June 2002 From f95d9ebc48b824368d0efc0296b7037364a83e35 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 11:03:50 -0400 Subject: [PATCH 017/106] Further documentation of Depth_list.nc checksums Additional documentation of the parameters used to store Depth_list.nc attribute names was added. --- src/diagnostics/MOM_sum_output.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 1a6cc58c1f..652b1934c5 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -42,7 +42,11 @@ module MOM_sum_output integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields character (*), parameter :: depth_chksum_attr = "bathyT_checksum" + !< Checksum of G%bathyT ove the compute + !! domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" + !< Checksum of G%mask2dT * G%areaT over + !! the compute domain !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. From ce93243bfc5c0544255397f5f2e7175ec6062872 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 11:06:54 -0400 Subject: [PATCH 018/106] Depth list documentation typo fix --- src/diagnostics/MOM_sum_output.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 652b1934c5..93f44a2bcc 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -42,7 +42,7 @@ module MOM_sum_output integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields character (*), parameter :: depth_chksum_attr = "bathyT_checksum" - !< Checksum of G%bathyT ove the compute + !< Checksum of G%bathyT over the compute !! domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" !< Checksum of G%mask2dT * G%areaT over From 087813d627ac0173b35f4f7d9fd58b530ddef64e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 16:17:02 -0400 Subject: [PATCH 019/106] Masked depth; style conformance The depth checksum is now replaced with masked depth, mask2dT * bathyT, and the calculation of the depth list has also been updated to use the masked depth. Various style conformance changes, such as contraction of do and if terminations (enddo, endif) and reduction of whitespace in various multiline function call, has also been applied. Finally, the attribute name docstrings were updated for clarity. --- src/diagnostics/MOM_sum_output.F90 | 61 ++++++++++++++---------------- 1 file changed, 29 insertions(+), 32 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 93f44a2bcc..b9d1b018c6 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -41,12 +41,14 @@ module MOM_sum_output ! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields -character (*), parameter :: depth_chksum_attr = "bathyT_checksum" - !< Checksum of G%bathyT over the compute +character (*), parameter :: depth_chksum_attr = "mask2dT_bathyT_checksum" + !< Checksum attribute name of + !! G%mask2dT * G%bathyT over the compute !! domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" - !< Checksum of G%mask2dT * G%areaT over - !! the compute domain + !< Checksum attribute of name of + !! G%mask2dT * G%areaT over the compute + !! domain !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. @@ -242,18 +244,15 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & CS%depth_list_file = trim(slasher(directory))//trim(CS%depth_list_file) call get_param(param_file, mdl, "REQUIRE_DEPTH_LIST_CHECKSUMS", & - CS%require_depth_list_chksum, & - desc="Require matching checksums in Depth_list.nc when reading\n" & - // "the file.", & - default=.true. & - ) + CS%require_depth_list_chksum, & + "Require that matching checksums be in Depth_list.nc\n" \\ & + "when reading the file.", default=.true.) if (.not. CS%require_depth_list_chksum) & call get_param(param_file, mdl, "UPDATE_DEPTH_LIST_CHECKSUMS", & - CS%update_depth_list_chksum, & - desc="Automatically update the Depth_list.nc file if the\n" & - // "checksums are missing or do not match current values.", & - default=.false. & - ) + CS%update_depth_list_chksum, & + "Automatically update the Depth_list.nc file if the\n" \\ & + "checksums are missing or do not match current values.", & + default=.false.) endif allocate(CS%lH(G%ke)) @@ -1129,8 +1128,8 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%bathyT(i,j) - Arealist(list_pos) = G%mask2dT(i,j)*G%areaT(i,j) + Dlist(list_pos) = G%mask2dT(i,j) * G%bathyT(i,j) + Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo ! These sums reproduce across PEs because the arrays are only nonzero on one PE. @@ -1350,31 +1349,30 @@ subroutine read_depth_list(G, US, CS, filename) var_msg = trim(CS%depth_list_file) // " checksums are missing;" if (CS%require_depth_list_chksum) then call MOM_error(FATAL, trim(var_msg) // " aborting.") - else if (CS%update_depth_list_chksum) then + elseif (CS%update_depth_list_chksum) then call MOM_error(WARNING, trim(var_msg) // " updating file.") call create_depth_list(G, CS) call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) return else call MOM_error(WARNING, & - trim(var_msg) // " some diagnostics may not be reproducible." & - ) - end if + trim(var_msg) // " some diagnostics may not be reproducible.") + endif else ! Validate netCDF call if (depth_attr_status /= NF90_NOERR) then var_msg = mdl // "Failed to read " // trim(filename) // ":" & // depth_chksum_attr - call MOM_error(FATAL, trim(var_msg) // " - " & - // NF90_STRERROR(depth_attr_status)) - end if + call MOM_error(FATAL, & + trim(var_msg) // " - " // NF90_STRERROR(depth_attr_status)) + endif if (area_attr_status /= NF90_NOERR) then var_msg = mdl // "Failed to read " // trim(filename) // ":" & // area_chksum_attr - call MOM_error(FATAL, trim(var_msg) // " - " & - // NF90_STRERROR(area_attr_status)) - end if + call MOM_error(FATAL, & + trim(var_msg) // " - " // NF90_STRERROR(area_attr_status)) + endif call get_depth_list_checksums(G, depth_grid_chksum, area_grid_chksum) @@ -1383,17 +1381,16 @@ subroutine read_depth_list(G, US, CS, filename) var_msg = trim(CS%depth_list_file) // " checksums do not match;" if (CS%require_depth_list_chksum) then call MOM_error(FATAL, trim(var_msg) // " aborting.") - else if (CS%update_depth_list_chksum) then + elseif (CS%update_depth_list_chksum) then call MOM_error(WARNING, trim(var_msg) // " updating file.") call create_depth_list(G, CS) call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) return else call MOM_error(WARNING, & - trim(var_msg) // " some diagnostics may not be reproducible." & - ) - end if - end if + trim(var_msg) // " some diagnostics may not be reproducible.") + endif + endif endif var_name = "depth" @@ -1486,7 +1483,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Depth checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%bathyT(i,j) + field(i,j) = G%mask2dT(i,j) * G%bathyT(i,j) enddo ; enddo write(depth_chksum, '(Z16)') mpp_chksum(field(:,:)) From 61a96a8a40b7c69da598efb4a67a3f71f5ba12bd Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 16:33:33 -0400 Subject: [PATCH 020/106] Token bugfix --- src/diagnostics/MOM_sum_output.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index b9d1b018c6..0757b8751e 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -245,12 +245,12 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & call get_param(param_file, mdl, "REQUIRE_DEPTH_LIST_CHECKSUMS", & CS%require_depth_list_chksum, & - "Require that matching checksums be in Depth_list.nc\n" \\ & + "Require that matching checksums be in Depth_list.nc\n" // & "when reading the file.", default=.true.) if (.not. CS%require_depth_list_chksum) & call get_param(param_file, mdl, "UPDATE_DEPTH_LIST_CHECKSUMS", & CS%update_depth_list_chksum, & - "Automatically update the Depth_list.nc file if the\n" \\ & + "Automatically update the Depth_list.nc file if the\n" // & "checksums are missing or do not match current values.", & default=.false.) endif From 9a1422f67b407c839e7afda18bac01baf9fe8049 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 25 Apr 2019 15:02:54 -0400 Subject: [PATCH 021/106] Revert masking of depth Using the masked depth (mask2dT * bathyT) was observed to change energy values within floating point precision, so the changes have been reverted. This may be revised at a later time, when we are prepared to update the energy stats to the new values in the regression tests. The depth checksum attribute has also been renamed to reflect this change. This will allow us to re-define the variable as masked at some later date, and can distinguish between the masked and unmasked checksums during testing. --- src/diagnostics/MOM_sum_output.F90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 0757b8751e..548e34434a 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -41,10 +41,9 @@ module MOM_sum_output ! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields -character (*), parameter :: depth_chksum_attr = "mask2dT_bathyT_checksum" - !< Checksum attribute name of - !! G%mask2dT * G%bathyT over the compute - !! domain +character (*), parameter :: depth_chksum_attr = "bathyT_checksum" + !< Checksum attribute name of G%bathyT + !! over the compute domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" !< Checksum attribute of name of !! G%mask2dT * G%areaT over the compute @@ -75,10 +74,10 @@ module MOM_sum_output real :: D_list_min_inc !< The minimum increment [Z ~> m], between the depths of the !! entries in the depth-list file, 0 by default. logical :: require_depth_list_chksum - !< Require matching checksums in Depth_list.nc when reading + !< Require matching checksums in Depth_list.nc when reading !! the file. logical :: update_depth_list_chksum - !< Automatically update the Depth_list.nc file if the + !< Automatically update the Depth_list.nc file if the !! checksums are missing or do not match current values. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes @@ -1128,7 +1127,7 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%mask2dT(i,j) * G%bathyT(i,j) + Dlist(list_pos) = G%bathyT(i,j) Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo From 0b33904ebd015aac1478c816437f95412c2fb632 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 25 Apr 2019 17:07:40 -0400 Subject: [PATCH 022/106] Bugfix: Checksum the unmasked depth --- src/diagnostics/MOM_sum_output.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 548e34434a..eb4214ea10 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -1482,7 +1482,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Depth checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%bathyT(i,j) + field(i,j) = G%bathyT(i,j) enddo ; enddo write(depth_chksum, '(Z16)') mpp_chksum(field(:,:)) From 97afc59e33fa45d8c2e2725d1cfb7e1260a7b5b3 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 3 May 2019 15:36:20 -0400 Subject: [PATCH 023/106] MEKE: Prevent div-by-zero by bathyT in beta calc The calculation of beta in the MEKE module had an explicit division by zero when computing the lateral topography derivatives, which were raising floating point exceptions in the debug builds. This occurs in the MEKE_equilibrium and MEKE_lengthScales functions. This issue was not observed in the production tests due to MEKE_TOPOGRAPHIC_BETA always being set to zero. When FPEs are disabled, the 0 * (1./0.) operation produces a NaN which is passed to a max() function, which ignores the NaN and always returns the other value. We resolve this by explicitly checking for zero values in bathyT and setting the topographic beta to zero when this term is zero. While this could potentially change the value of the Rhines scale, these values only occur over land, which are in general masked, and should not affect the calculation. The unoptimized expressions were retained, but recommended changes which reduce the number of divisions were included in comments. No value changes were observed in our test suite, and the patch should be bitwise reproducible. Minor changes: - We do not calculate the topographic beta term if the scaling factor, MEKE_TOPOGRAPHIC_BETA is zero - the default value of beta was unset in MEKE_lengthScales was unset when CS%use_old_lscale is True, so we set this to zero. - Minor whitespace and index syntax changes --- src/parameterizations/lateral/MOM_MEKE.F90 | 61 +++++++++++++++++----- 1 file changed, 48 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index e170087180..87e78efe45 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -562,6 +562,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -581,11 +582,26 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m FatH = 0.25*US%s_to_T*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points - !### This expression should be recast to use a single division, but it will change answers. - beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & - (G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & - + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & - *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) + + ! If bathyT is zero, then a division by zero FPE will be raised. In this + ! case, we apply Adcroft's rule of reciprocals and set the term to zero. + ! Since zero-bathymetry cells are masked, this should not affect values. + if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.) then + beta_topo_x = 0. ; beta_topo_y = 0. + else + !### These expressions should be recast to use a single division, but it will change answers. + !beta_topo_x = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) + !beta_topo_y = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) + beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) + beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + endif + + beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & + + ((US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2)) I_H = GV%Rho0 * I_mass(i,j) @@ -693,6 +709,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady real :: beta, SN real :: FatH ! Coriolis parameter at h points [s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -701,17 +718,35 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif - FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & - ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points - !### This expression should be recast to use a single division, but it will change answers. - beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & - *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & - + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & - *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) + FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1) ) + & + ( G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1) ) ) ! Coriolis parameter at h points + + ! If bathyT is zero, then a division by zero FPE will be raised. In this + ! case, we apply Adcroft's rule of reciprocals and set the term to zero. + ! Since zero-bathymetry cells are masked, this should not affect values. + if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.0) then + beta_topo_x = 0. ; beta_topo_y = 0. + else + !### These expressions should be recast to use a single division, but it will change answers. + !beta_topo_x = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) + !beta_topo_y = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) + beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) + beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + endif + + beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & + + ((US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2)) + + else + beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & From af65692778d876ca00db48f7ee77288beb9b7b0c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 3 May 2019 16:16:24 -0400 Subject: [PATCH 024/106] Add FMS/coupler_types.F90 to build Travis-CI build path --- .testing/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.testing/Makefile b/.testing/Makefile index d0f098e411..ee561375a3 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -18,7 +18,7 @@ else EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL endif -FMS_PACKAGES ?= platform,include,memutils,constants,mpp,fms,time_manager,diag_manager,data_override,coupler/ensemble_manager.F90,axis_utils,horiz_interp,time_interp,astronomy,mosaic,random_numbers +FMS_PACKAGES ?= platform,include,memutils,constants,mpp,fms,time_manager,diag_manager,data_override,coupler/coupler_types.F90,coupler/ensemble_manager.F90,axis_utils,horiz_interp,time_interp,astronomy,mosaic,random_numbers TEMPLATE ?= .testing/linux-ubuntu-xenial-gnu.mk MPIRUN ?= mpirun From 8486c045c187a772a09a5bd66a37c6bc2659b7cf Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 3 May 2019 16:31:11 -0400 Subject: [PATCH 025/106] Use xanadu-fms version of MRS in gitlab pipeline --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 3f90330986..7ad78049f3 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -32,9 +32,9 @@ setup: - git clone --recursive http://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git tests && cd tests # Install / update testing scripts - git clone https://github.com/adcroft/MRS.git MRS - - (cd MRS ; git checkout 9badc63acefbf038) + - (cd MRS ; git checkout xanadu-fms) # Update MOM6-examples and submodules - - (cd MOM6-examples && git checkout . && git checkout dev/gfdl && git pull && git checkout cf73a9ad63f8ccf7 && git submodule init && git submodule update) + - (cd MOM6-examples && git checkout . && git checkout dev/gfdl && git pull && git submodule init && git submodule update) - (cd MOM6-examples/src/MOM6 && git submodule update) - test -d MOM6-examples/src/LM3 || make -f MRS/Makefile.clone clone_gfdl -s - make -f MRS/Makefile.clone MOM6-examples/.datasets -s From 4d214cb410e3954f59b59e553ee6b22fa7dcc8c6 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 May 2019 12:30:32 -0400 Subject: [PATCH 026/106] MOM_set_diffusivity: OMEGA scaling Implementation of OMEGA parameter rescaling (s-1 -> T-1) in the MOM_set_diffusivity module. --- .../vertical/MOM_set_diffusivity.F90 | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 962a9d07c2..0f6b0dd417 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -97,7 +97,7 @@ module MOM_set_diffusivity real :: TKE_itide_max !< maximum internal tide conversion [W m-2] !! available to mix above the BBL - real :: omega !< Earth's rotation frequency [s-1] + real :: omega !< Earth's rotation frequency [T-1] logical :: ML_radiation !< allow a fraction of TKE available from wind work !! to penetrate below mixed layer base with a vertical !! decay scale determined by the minimum of @@ -284,7 +284,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & I_Rho0 = 1.0/GV%Rho0 kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. dt_fill = 7200. !### Dimensionalconstant [s]. - Omega2 = CS%Omega*CS%Omega + Omega2 = (US%s_to_T**2) * CS%omega * CS%omega use_EOS = associated(tv%eqn_of_state) @@ -721,7 +721,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & is = G%isc ; ie = G%iec ; nz = G%ke I_dt = 1.0/dt - Omega2 = CS%Omega**2 + Omega2 = (US%s_to_T**2) * CS%omega**2 G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 @@ -855,7 +855,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) TKE_to_Kd(i,k) = US%m_to_Z**3 / (G_Rho0 * dRho_lay + & - CS%Omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) + (US%s_to_T**2 * CS%omega**2) * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif enddo ; enddo @@ -1421,7 +1421,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & do_diag_Kd_BBL = associated(Kd_BBL) N2_min = 0. - if (CS%LOTW_BBL_use_omega) N2_min = (CS%omega**2) + if (CS%LOTW_BBL_use_omega) N2_min = (US%s_to_T**2 * CS%omega**2) ! Determine whether to add Rayleigh drag contribution to TKE Rayleigh_drag = .false. @@ -1569,7 +1569,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, integer :: i, k, is, ie, nz, kml is = G%isc ; ie = G%iec ; nz = G%ke - Omega2 = CS%Omega**2 + Omega2 = US%s_to_T**2 * CS%omega**2 C1_6 = 1.0 / 6.0 kml = GV%nkml h_neglect = GV%H_subroundoff*GV%H_to_Z @@ -1951,7 +1951,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%Kdml = 0.0 ; CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 CS%bulkmixedlayer = (GV%nkml > 0) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1964,7 +1963,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "FLUX_RI_MAX*N2/(N2+OMEGA2).", default=0.2) call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=US%T_to_s) call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind \n"//& @@ -1974,7 +1973,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "length scale.", default=.false.) if (CS%ML_radiation) then ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_subroundoff*GV%H_to_Z) + CS%ustar_min = 2e-4*(US%s_to_T * CS%omega)*(GV%Angstrom_Z + GV%H_subroundoff*GV%H_to_Z) call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, & "A coefficient that is used to scale the penetration \n"//& From 9487df0e2ebb14a7ee0faf3bbddf4ad9deb065af Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 May 2019 13:22:53 -0400 Subject: [PATCH 027/106] MOM_set_diffusivity: Rescaling of Omega2, G_Rho0 --- .../vertical/MOM_set_diffusivity.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 0f6b0dd417..a096c56082 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -97,7 +97,7 @@ module MOM_set_diffusivity real :: TKE_itide_max !< maximum internal tide conversion [W m-2] !! available to mix above the BBL - real :: omega !< Earth's rotation frequency [T-1] + real :: omega !< Earth's rotation frequency [T-1 ~> s-1] logical :: ML_radiation !< allow a fraction of TKE available from wind work !! to penetrate below mixed layer base with a vertical !! decay scale determined by the minimum of @@ -121,7 +121,7 @@ module MOM_set_diffusivity !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems [Z s-1 ~> m s-1]. If the value is small enough, + !! problems [Z T-1 ~> m s-1]. If the value is small enough, !! this parameter should not affect the solution. real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale [nondim] real :: mstar !< ratio of friction velocity cubed to @@ -257,7 +257,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real :: I_Rho0 ! inverse of Boussinesq density [m3 kg-1] real :: dissip ! local variable for dissipation calculations [Z2 W m-5 ~> W m-3] - real :: Omega2 ! squared absolute rotation rate [s-2] + real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2] logical :: use_EOS ! If true, compute density from T/S using equation of state. type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space @@ -284,7 +284,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & I_Rho0 = 1.0/GV%Rho0 kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. dt_fill = 7200. !### Dimensionalconstant [s]. - Omega2 = (US%s_to_T**2) * CS%omega * CS%omega + Omega2 = CS%omega * CS%omega use_EOS = associated(tv%eqn_of_state) @@ -508,7 +508,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + (US%s_to_T**2 * Omega2)))) ) enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie @@ -516,7 +516,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & 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(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + (US%s_to_T**2 * Omega2)))) ) enddo ; enddo ; endif endif @@ -709,8 +709,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! undergo before entraining all fluid in the layers ! above or below [Z ~> m]. real :: dRho_lay ! density change across a layer [kg m-3] - real :: Omega2 ! rotation rate squared [s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 s-2 kg-1] + real :: Omega2 ! rotation rate squared [T-2 ~> s-2] + real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 T-2 kg-1 -> m4 s-2 kg-1] real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] real :: I_dt ! 1/dt [s-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] @@ -721,15 +721,15 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & is = G%isc ; ie = G%iec ; nz = G%ke I_dt = 1.0/dt - Omega2 = (US%s_to_T**2) * CS%omega**2 - G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 + Omega2 = CS%omega**2 + G_Rho0 = (GV%g_Earth*US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. + hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + (US%s_to_T**2 * Omega2) ) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif @@ -830,7 +830,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & enddo do k=2,kmb ; do i=is,ie maxTKE(i,k) = 0.0 - TKE_to_Kd(i,k) = US%m_to_Z**3 / ((N2_lay(i,k) + Omega2) * & + TKE_to_Kd(i,k) = US%m_to_Z**3 / ((N2_lay(i,k) + (US%s_to_T**2 * Omega2)) * & (GV%H_to_Z*(h(i,j,k) + H_neglect))) enddo ; enddo do k=kmb+1,kb_min-1 ; do i=is,ie @@ -854,7 +854,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & maxTKE(i,k) = I_dt*US%Z_to_m * ((GV%g_Earth * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) - TKE_to_Kd(i,k) = US%m_to_Z**3 / (G_Rho0 * dRho_lay + & + TKE_to_Kd(i,k) = US%m_to_Z**3 / ((US%s_to_T**2 * G_Rho0) * dRho_lay + & (US%s_to_T**2 * CS%omega**2) * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif enddo ; enddo @@ -906,14 +906,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & real :: Rml_base ! density of the deepest variable density layer real :: dz_int ! thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density - ! times some unit conversion factors [Z m3 s-2 kg-1 ~> m4 s-2 kg-1]. + ! times some unit conversion factors [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. real :: H_neglect ! negligibly small thickness, in the same units as h. logical :: do_i(SZI_(G)), do_any integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 + G_Rho0 = (GV%g_Earth*US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -950,12 +950,12 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & ! Set the buoyancy frequencies. do k=1,nz ; do i=is,ie - N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & + N2_lay(i,k) = (US%s_to_T**2 * G_Rho0) * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & (GV%H_to_Z*(h(i,j,k) + H_neglect)) enddo ; enddo do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo do K=2,nz ; do i=is,ie - N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & + N2_int(i,K) = (US%s_to_T**2 * G_Rho0) * dRho_int(i,K) / & (0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k) + H_neglect)) enddo ; enddo @@ -998,7 +998,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & do i=is,ie if (hb(i) > 0.0) then - N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) + N2_bot(i) = ((US%s_to_T **2 * G_Rho0) * dRho_bot(i)) / hb(i) else ; N2_bot(i) = 0.0 ; endif z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) @@ -1410,7 +1410,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: Kd_lower ! diffusivity for lower interface [Z2 s-1 ~> m2 s-1] real :: ustar_D ! u* x D [Z2 s-1 ~> m2 s-1]. real :: I_Rho0 ! 1 / rho0 - real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall [s-2] + 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. integer :: i, k, km1 @@ -1421,7 +1421,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & do_diag_Kd_BBL = associated(Kd_BBL) N2_min = 0. - if (CS%LOTW_BBL_use_omega) N2_min = (US%s_to_T**2 * CS%omega**2) + if (CS%LOTW_BBL_use_omega) N2_min = CS%omega**2 ! Determine whether to add Rayleigh drag contribution to TKE Rayleigh_drag = .false. @@ -1496,7 +1496,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! TKE associated with Kd_wall [m3 s-2]. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = US%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = US%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), (US%s_to_T**2 * N2_min)) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall > 0.) then @@ -1558,7 +1558,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, real :: ustar_sq ! ustar squared [Z2 s-2 ~> m2 s-2] real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 s-1 ~> m2 s-1]. real :: C1_6 ! 1/6 - real :: Omega2 ! rotation rate squared [s-2]. + real :: Omega2 ! rotation rate squared [T-2 ~> s-2]. real :: z1 ! layer thickness times I_decay [nondim] real :: dzL ! thickness converted to heights [Z ~> m]. real :: I_decay_len2_TKE ! squared inverse decay lengthscale for @@ -1569,7 +1569,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, integer :: i, k, is, ie, nz, kml is = G%isc ; ie = G%iec ; nz = G%ke - Omega2 = US%s_to_T**2 * CS%omega**2 + Omega2 = CS%omega**2 C1_6 = 1.0 / 6.0 kml = GV%nkml h_neglect = GV%H_subroundoff*GV%H_to_Z @@ -1581,15 +1581,15 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then if (CS%ML_omega_frac >= 1.0) then - f_sq = 4.0*Omega2 + f_sq = 4.0*(US%s_to_T**2 * Omega2) else f_sq = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) if (CS%ML_omega_frac > 0.0) & - f_sq = CS%ML_omega_frac*4.0*Omega2 + (1.0-CS%ML_omega_frac)*f_sq + f_sq = CS%ML_omega_frac*4.0*(US%s_to_T**2 * Omega2) + (1.0-CS%ML_omega_frac)*f_sq endif - ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 + ustar_sq = max(fluxes%ustar(i,j), US%s_to_T * CS%ustar_min)**2 TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(US%Z_to_m**3*ustar_sq*fluxes%ustar(i,j)) I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) @@ -1646,7 +1646,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*US%Z_to_m**3*Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*US%Z_to_m**3*(US%s_to_T**2 * Omega2)) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -1973,7 +1973,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "length scale.", default=.false.) if (CS%ML_radiation) then ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*(US%s_to_T * CS%omega)*(GV%Angstrom_Z + GV%H_subroundoff*GV%H_to_Z) + CS%ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + GV%H_subroundoff*GV%H_to_Z) call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, & "A coefficient that is used to scale the penetration \n"//& From 8461ae1f40a75aef1f95265468c3866262351bb4 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 May 2019 16:13:09 -0400 Subject: [PATCH 028/106] MOM_set_diffusivity: N, dissipation scaling This commit rescales the internal buoyancy frequencies (N2) and associated parameters in the MOM_set_diffusivity module. Coefficients used in computation of dissipation have also been scaled relative to W m-3, e.g. W m-3 s2 is rescaled to W m-3 T2. Scaled parameters: * DISSIPATION_N1 (partial): W m-3 T * DISSIPATION_N2 (partial): W m-3 T2 * DISSIPATION_KD_MIN: Z2 T-1 --- .../vertical/MOM_set_diffusivity.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a096c56082..a5f2fbb677 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -91,9 +91,9 @@ module MOM_set_diffusivity !! than the following: real :: dissip_min !< Minimum dissipation [Z2 m-2 W m-3 ~> W m-3] real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [Z2 m-2 W m-3 ~> W m-3] - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [Z2 m-2 W m-3 s ~> J m-3] + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [Z2 m-2 W m-3 T ~> J m-3] real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [Z2 m-2 W m-3 s2 ~> J s m-3] - real :: dissip_Kd_min !< Minimum Kd [Z2 s-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 + real :: dissip_Kd_min !< Minimum Kd [Z2 T-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion [W m-2] !! available to mix above the BBL @@ -231,7 +231,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! local variables real, dimension(SZI_(G)) :: & - N2_bot ! bottom squared buoyancy frequency [s-2] + N2_bot ! bottom squared buoyancy frequency [T-2 ~> s-2] type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags @@ -243,14 +243,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! after full convective adjustment. real, dimension(SZI_(G),SZK_(G)) :: & - N2_lay, & !< squared buoyancy frequency associated with layers [s-2] + N2_lay, & !< squared buoyancy frequency associated with layers [T-2 ~> s-2] maxTKE, & !< energy required to entrain to h_max [m3 s-3] TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between !< TKE dissipated within a layer and Kd in that layer, in !< m2 s-1 / m3 s-3 = [s2 m-1]. real, dimension(SZI_(G),SZK_(G)+1) :: & - N2_int, & !< squared buoyancy frequency associated at interfaces [s-2] + N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] dRho_int, & !< locally ref potential density difference across interfaces [kg m-3] KT_extra, & !< double difusion diffusivity of temperature [Z2 s-1 ~> m2 s-1] KS_extra !< double difusion diffusivity of salinity [Z2 s-1 ~> m2 s-1] @@ -401,11 +401,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, N2_lay, N2_int, N2_bot) if (associated(dd%N2_3d)) then - do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = US%s_to_T**2 * N2_int(i,K) ; enddo ; enddo endif ! Add background mixing - call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, US, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, US%s_to_T**2 * N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, US, CS%bkgnd_mixing_csp) ! Double-diffusion (old method) if (CS%double_diffusion) then @@ -482,8 +482,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tm_csp, & - N2_lay, N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) + call calculate_tidal_mixing(h, US%s_to_T**2 * N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tm_csp, & + US%s_to_T**2 * N2_lay, US%s_to_T**2 * N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. @@ -506,23 +506,23 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & do k=2,nz-1 ; do i=is,ie dissip = max( CS%dissip_min, & ! Const. floor on dissip. CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett - CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri + CS%dissip_N2 * N2_lay(i,k)) ! Floor of Kd_min*rho0/F_Ri Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + (US%s_to_T**2 * Omega2)))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * ((US%s_to_T**2 * N2_lay(i,k)) + (US%s_to_T**2 * Omega2)))) ) enddo ; enddo if (present(Kd_int)) then ; 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 + CS%dissip_N2 * N2_int(i,K)) ! Floor of Kd_min*rho0/F_Ri Kd_int(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + (US%s_to_T**2 * Omega2)))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * ((US%s_to_T**2 * N2_int(i,K)) + (US%s_to_T**2 * Omega2)))) ) enddo ; enddo ; endif endif if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * US%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * & + dd%Kd_Work(i,j,k) = GV%Rho0 * (US%Z_to_m**3 * Kd_lay(i,j,k)) * (US%s_to_T**2 * N2_lay(i,k)) * & GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3 enddo ; enddo endif @@ -670,7 +670,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density !! across each interface [kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the - !! layers [s-2]. + !! layers [T-2 ~> s-2]. integer, intent(in) :: j !< j-index of row to work on real, intent(in) :: dt !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure @@ -729,7 +729,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + (US%s_to_T**2 * Omega2) ) ! Units of m3 Z-2 s-2. + hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ((US%s_to_T**2 * N2_lay(i,k)) + (US%s_to_T**2 * Omega2)) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif @@ -830,7 +830,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & enddo do k=2,kmb ; do i=is,ie maxTKE(i,k) = 0.0 - TKE_to_Kd(i,k) = US%m_to_Z**3 / ((N2_lay(i,k) + (US%s_to_T**2 * Omega2)) * & + TKE_to_Kd(i,k) = US%m_to_Z**3 / (((US%s_to_T**2 * N2_lay(i,k)) + (US%s_to_T**2 * Omega2)) * & (GV%H_to_Z*(h(i,j,k) + H_neglect))) enddo ; enddo do k=kmb+1,kb_min-1 ; do i=is,ie @@ -884,10 +884,10 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & intent(out) :: dRho_int !< Change in locally referenced potential density !! across each interface [kg m-3]. real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces [s-2]. + intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(G)), & - intent(out) :: N2_lay !< The squared buoyancy frequency of the layers [s-2]. - real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency [s-2]. + intent(out) :: N2_lay !< The squared buoyancy frequency of the layers [T-2 ~> s-2]. + real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency [T-2 ~> s-2]. ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & dRho_int_unfilt, & ! unfiltered density differences across interfaces @@ -950,12 +950,12 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & ! Set the buoyancy frequencies. do k=1,nz ; do i=is,ie - N2_lay(i,k) = (US%s_to_T**2 * G_Rho0) * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & + N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & (GV%H_to_Z*(h(i,j,k) + H_neglect)) enddo ; enddo do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo do K=2,nz ; do i=is,ie - N2_int(i,K) = (US%s_to_T**2 * G_Rho0) * dRho_int(i,K) / & + N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & (0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k) + H_neglect)) enddo ; enddo @@ -998,7 +998,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & do i=is,ie if (hb(i) > 0.0) then - N2_bot(i) = ((US%s_to_T **2 * G_Rho0) * dRho_bot(i)) / hb(i) + N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) else ; N2_bot(i) = 0.0 ; endif z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) @@ -1382,7 +1382,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & !! boundary layer properies, and related fields. integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(G)+1), & - intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [s-2] + intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [T-2 ~> s-2] type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 s-1 ~> m2 s-1] @@ -1496,7 +1496,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! TKE associated with Kd_wall [m3 s-2]. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = US%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), (US%s_to_T**2 * N2_min)) + TKE_Kd_wall = US%Z_to_m**3 * US%s_to_T**2 * Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall > 0.) then @@ -2135,16 +2135,16 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0, scale=US%m_to_Z**2) + units="J m-3", default=0.0, scale=(US%m_to_Z**2)*US%s_to_T) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & - units="m2 s-1", default=0.0, scale=US%m_to_Z**2) + units="m2 s-1", default=0.0, scale=(US%m_to_Z**2)*US%T_to_s) CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. & (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) CS%dissip_N2 = 0.0 if (CS%FluxRi_max > 0.0) & - CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max + CS%dissip_N2 = US%s_to_T**3 * CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=US%Z_to_m**2) From ed9d9f15257b5986c3a03957b95f679813c98074 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 May 2019 18:01:30 -0400 Subject: [PATCH 029/106] dissip_N2 dimension update --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a5f2fbb677..1fa0732f54 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -92,7 +92,7 @@ module MOM_set_diffusivity real :: dissip_min !< Minimum dissipation [Z2 m-2 W m-3 ~> W m-3] real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [Z2 m-2 W m-3 ~> W m-3] real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [Z2 m-2 W m-3 T ~> J m-3] - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [Z2 m-2 W m-3 s2 ~> J s m-3] + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [Z2 m-2 W m-3 T2 ~> J s m-3] real :: dissip_Kd_min !< Minimum Kd [Z2 T-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion [W m-2] From 2015e633614bb5ec5138b50860f38f62a24e94c5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 May 2019 04:05:53 -0400 Subject: [PATCH 030/106] (*)Revised propagate_int_tide code for symmetry Revised propagate_int_tide code for symmetry, and removed the old and unused debugging code setting an internal tide point source. These could change answers at the level of roundoff and MOM_parameter_doc files in cases that have INTERNAL_TIDES=True, but all answers are bitwise identical in the MOM6-examples test cases. --- .../lateral/MOM_internal_tides.F90 | 27 +++---------------- 1 file changed, 4 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 27115dec67..4850770f26 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -108,10 +108,6 @@ module MOM_internal_tides !< The internal wave energy density as a function of (i,j,angle); temporary for restart real, allocatable, dimension(:) :: frequency !< The frequency of each band [s-1]. - !### Delete later - real :: int_tide_source_x !< X Location of generation site for internal tide testing - real :: int_tide_source_y !< Y Location of generation site for internal tide testing - 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() @@ -215,10 +211,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq) do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - !### For rotational symmetry this should be - ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector*(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -228,10 +221,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & a = CS%energized_angle do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - !### For rotational symmetry this should be - ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector**(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -427,11 +417,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes - f2 = 0.25*US%s_to_T**2*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2 + & - G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2 ) - !### For rotational symmetry this should be - ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then @@ -2424,12 +2411,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1) !call pass_var(G%dx_Cv,G%domain) - ! For debugging - delete later - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1.) - ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & Time, 'Local angle of coastline/ridge/shelf with respect to equator', 'rad') From dc35d3a00ab2cd04d4571e6c52f20b22e160310a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 May 2019 04:07:28 -0400 Subject: [PATCH 031/106] +(*)Revised the diagnostic subML_N2 Revised the calculation of the diagnostic subML_N2 inside of diagnoseMLDbyDensityDifference, and added as an optional argument the depth extent over which this stratification was calculated. The previous code used inconsistent pressures in calculating the densities and was simply wrong. This changes a diagnostic (subML_N2) and adds a new optional interface. All solutions are bitwise identical but there are new entries in MOM_parameter_doc files. --- .../vertical/MOM_diabatic_aux.F90 | 100 ++++++++++-------- .../vertical/MOM_diabatic_driver.F90 | 10 +- 2 files changed, 63 insertions(+), 47 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index e8b4500bbc..a7ccd23d09 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -338,8 +338,7 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) salt_add_col(:,:) = 0.0 -!$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,tv,h,salt_add_col, S_min) & -!$OMP private(mc) + !$OMP parallel do default(none) private(mc) do j=js,je do k=nz,1,-1 ; do i=is,ie if ((G%mask2dT(i,j) > 0.0) .and. & @@ -643,7 +642,8 @@ end subroutine find_uv_at_h !> Diagnose a mixed layer depth (MLD) determined by a given density difference with the surface. !> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping. -subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, diagPtr, id_N2subML, id_MLDsq) +subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, diagPtr, & + id_N2subML, id_MLDsq, dz_subML) type(ocean_grid_type), intent(in) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -656,19 +656,25 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, type(diag_ctrl), pointer :: diagPtr !< Diagnostics structure integer, optional, intent(in) :: id_N2subML !< Optional handle (ID) of subML stratification integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD + real, optional, intent(in) :: dz_subML !< The distance over which to calculate N2subML + !! or 50 m if missing [Z ~> m] ! Local variables real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [kg m-3]. - real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures [Pa]. - real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths [Z ~> m]. - real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2 [kg m-3]. + real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures [Pa]. + real, dimension(SZI_(G)) :: H_subML, dH_N2 ! Summed thicknesses used in N2 calculation [H ~> m]. + real, dimension(SZI_(G)) :: T_subML, T_deeper ! Temperatures used in the N2 calculation [degC]. + real, dimension(SZI_(G)) :: S_subML, S_deeper ! Salinities used in the N2 calculation [ppt]. + real, dimension(SZI_(G)) :: rho_subML, rho_deeper ! Densities used in the N2 calculation [kg m-3]. + real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m]. + real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixedlayer depth [kg m-3]. real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [s-2]. real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. - real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit - ! conversion factor [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + logical, dimension(SZI_(G)) :: N2_region_set ! If true, all necessary values for calculating N2 + ! have been stored already. real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [m4 s-2 kg-1]. - real :: dz_subML ! Depth below ML over which to diagnose stratification [Z ~> m]. + real :: dH_subML ! Depth below ML over which to diagnose stratification [H ~> m]. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho @@ -676,12 +682,12 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq - Rho_x_gE = GV%g_Earth * GV%Rho0 gE_rho0 = US%m_to_Z**2 * GV%g_Earth / GV%Rho0 - dz_subML = 50.*US%m_to_Z + dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - pRef_MLD(:) = 0. ; pRef_N2(:) = 0. + + pRef_MLD(:) = 0.0 do j=js,je do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_Z ; enddo ! Depth of center of surface layer call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is, ie-is+1, tv%eqn_of_state) @@ -689,11 +695,10 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, deltaRhoAtK(i) = 0. MLD(i,j) = 0. if (id_N2>0) then - subMLN2(i,j) = 0. - rho1(i) = 0. - d1(i) = 0. - pRef_N2(i) = Rho_x_gE * h(i,j,1) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = GV%H_to_Pa * h(i,j,1) ! This might change answers at roundoff. + subMLN2(i,j) = 0.0 + H_subML(i) = h(i,j,1) ; dH_N2(i) = 0.0 + T_subML(i) = 0.0 ; S_subML(i) = 0.0 ; T_deeper(i) = 0.0 ; S_deeper(i) = 0.0 + N2_region_set(i) = (G%mask2dT(i,j)<0.5) ! Only need to work on ocean points. endif enddo do k=2,nz @@ -702,27 +707,23 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_Z ! Depth of center of layer K enddo - ! Stratification, N2, immediately below the mixed layer, averaged over at least 50 m. + ! Prepare to calculate stratification, N2, immediately below the mixed layer by finding + ! the cells that extend over at least dz_subML. if (id_N2>0) then - do i=is,ie - pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) - !### This might change answers at roundoff. - enddo - call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state) - do i=is,ie - if (MLD(i,j)>0. .and. subMLN2(i,j)==0.) then ! This block is below the mixed layer - if (d1(i)==0.) then ! Record the density, depth and pressure, immediately below the ML - rho1(i) = rhoAtK(i) - d1(i) = dK(i) - !### It looks to me like there is bad logic here. - RWH - ! Use pressure at the bottom of the upper layer used in calculating d/dz rho - pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) - !### This might change answers at roundoff. - endif - if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then - subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) + do i=is,ie + if (MLD(i,j)==0.0) then ! Still in the mixed layer. + H_subML(i) = H_subML(i) + h(i,j,k) + elseif (.not.N2_region_set(i)) then ! This block is below the mixed layer, but N2 has not been found yet. + if (dH_N2(i)==0.0) then ! Record the temperature, salinity, pressure, immediately below the ML + T_subML(i) = tv%T(i,j,k) ; S_subML(i) = tv%S(i,j,k) + H_subML(i) = H_subML(i) + 0.5 * h(i,j,k) ! Start midway through this layer. + dH_N2(i) = 0.5 * h(i,j,k) + elseif (dH_N2(i) + h(i,j,k) < dH_subML) then + dH_N2(i) = dH_N2(i) + h(i,j,k) + else ! This layer includes the base of the region where N2 is calculated. + T_deeper(i) = tv%T(i,j,k) ; S_deeper(i) = tv%S(i,j,k) + dH_N2(i) = dH_N2(i) + 0.5 * h(i,j,k) + N2_region_set(i) = .true. endif endif enddo ! i-loop @@ -744,11 +745,21 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, enddo ! k-loop do i=is,ie if ((MLD(i,j)==0.) .and. (deltaRhoAtK(i)0 .and. subMLN2(i,j)==0. .and. d1(i)>0. .and. dK(i)-d1(i)>0.) then - ! ! Use what ever stratification we can, measured over what ever distance is available - ! subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) - ! endif enddo + + if (id_N2>0) then ! Now actually calculate stratification, N2, below the mixed layer. + do i=is,ie ; pRef_N2(i) = GV%H_to_Pa * (H_subML(i) + 0.5*dH_N2(i)) ; enddo + ! if ((.not.N2_region_set(i)) .and. (dH_N2(i) > 0.5*dH_subML)) then + ! ! Use whatever stratification we can, measured over whatever distance is available? + ! T_deeper(i) = tv%T(i,j,nz) ; S_deeper(i) = tv%S(i,j,nz) + ! N2_region_set(i) = .true. + ! endif + call calculate_density(T_subML, S_subML, pRef_N2, rho_subML, is, ie-is+1, tv%eqn_of_state) + call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, is, ie-is+1, tv%eqn_of_state) + do i=is,ie ; if ((G%mask2dT(i,j)>0.5) .and. N2_region_set(i)) then + subMLN2(i,j) = gE_rho0 * (rho_deeper(i) - rho_subML(i)) / (GV%H_to_z * dH_N2(i)) + endif ; enddo + endif enddo ! j-loop if (id_MLD > 0) call post_data(id_MLD, MLD, diagPtr) @@ -1101,13 +1112,12 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! Diagnostics of heat content associated with mass fluxes if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & - tv%T(i,j,k) * max(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt + T2d(i,k) * max(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & - tv%T(i,j,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt + T2d(i,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & - tv%T(i,j,k) * dThickness * GV%H_to_kg_m2 -!### NOTE: tv%T should be T2d in the expressions above. + T2d(i,k) * dThickness * GV%H_to_kg_m2 ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 24a529716d..b5141c2515 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -174,6 +174,8 @@ module MOM_diabatic_driver logical :: debug_energy_req !< If true, test the mixing energy requirement code. type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output real :: MLDdensityDifference !< Density difference used to determine MLD_user + real :: dz_subML_N2 !< The distance over which to calculate a diagnostic of the + !! average stratification at the base of the mixed layer [Z ~> m]. integer :: nsw !< SW_NBANDS !>@{ Diagnostic IDs @@ -1100,7 +1102,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) endif if (CS%id_MLD_0125 > 0) then call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) @@ -2397,7 +2399,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) endif if (CS%id_MLD_0125 > 0) then call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) @@ -3030,6 +3032,10 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& "The MLD is the depth at which the density is larger than the\n"//& "surface density by the specified amount.", units='kg/m3', default=0.1) + call get_param(param_file, mdl, "DIAG_DEPTH_SUBML_N2", CS%dz_subML_N2, & + "The distance over which to calculate a diagnostic of the \n"//& + "stratification at the base of the mixed layer.", & + units='m', default=50.0, scale=US%m_to_Z) ! diagnostics making use of the z-gridding code if (associated(diag_to_Z_CSp)) then From 62c113ee04801da28e369da874839b5f4a1cd8a8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 May 2019 07:31:25 -0400 Subject: [PATCH 032/106] +Added MIN_SALINITY as a new runtime parameter. Added the new runtime parameter MIN_SALINITY, with a default value that duplicates the current hard-coded value. Also stored this value in a new element in the thermo_vars type, and corrected a few spelling errors. By default all answers are bitwise identical but there are new entries in the MOM_parameter_doc.all files. --- src/core/MOM.F90 | 8 ++++-- src/core/MOM_variables.F90 | 8 ++++-- .../vertical/MOM_diabatic_aux.F90 | 28 +++++++++---------- 3 files changed, 24 insertions(+), 20 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 21ec2e6dc6..4762e9f26d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1516,7 +1516,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & count_calls, tracer_flow_CSp) type(time_type), target, intent(inout) :: Time !< model time, set in this routine type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar - type(param_file_type), intent(out) :: param_file !< structure indicating paramater file to parse + type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse type(directories), intent(out) :: dirs !< structure with directory paths type(MOM_control_struct), pointer :: CS !< pointer set in this routine to MOM control structure type(MOM_restart_CS), pointer :: restart_CSp !< pointer set in this routine to the @@ -1830,6 +1830,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If true, limit salinity to being positive. (The sea-ice \n"//& "model may ask for more salt than is available and \n"//& "drive the salinity negative otherwise.)", default=.false.) + call get_param(param_file, "MOM", "MIN_SALINITY", CS%tv%min_salinity, & + "The minimum value of salinity when BOUND_SALINITY=True. \n"//& + "The default is 0.01 for backward compatibility but ideally \n"//& + "should be 0.", units="PPT", default=0.01, do_not_log=.not.bound_salinity) call get_param(param_file, "MOM", "C_P", CS%tv%C_p, & "The heat capacity of sea water, approximated as a \n"//& "constant. This is only used if ENABLE_THERMODYNAMICS is \n"//& @@ -3410,7 +3414,7 @@ end subroutine MOM_end !! * src/tracer: !! These files handle the lateral transport and diffusion of !! tracers, or are the code to implement various passive tracer -!! packages. Additional tracer packages are readily accomodated. +!! packages. Additional tracer packages are readily accommodated. !! !! * src/user: !! These are either stub routines that a user could use to change diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index c623848c15..f668f24508 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -80,7 +80,7 @@ module MOM_variables !> Pointers to an assortment of thermodynamic fields that may be available, including !! potential temperature, salinity, heat capacity, and the equation of state control structure. type, public :: thermo_var_ptrs -! If allocated, the following variables have nz layers. + ! If allocated, the following variables have nz layers. real, pointer :: T(:,:,:) => NULL() !< Potential temperature [degC]. real, pointer :: S(:,:,:) => NULL() !< Salnity [PSU] or [gSalt/kg], generically [ppt]. type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the @@ -95,14 +95,16 @@ module MOM_variables !! 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]. -! These arrays are accumulated fluxes for communication with other components. + 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. real, dimension(:,:), pointer :: frazil => NULL() !< The energy needed to heat the ocean column to the !! freezing point since calculate_surface_state was2 !! last called [J m-2]. real, dimension(:,:), pointer :: salt_deficit => NULL() !< The salt needed to maintain the ocean column - !! at a minumum salinity of 0.01 PSU since the last time + !! at a minimum salinity of MIN_SALINITY since the last time !! that calculate_surface_state was called, [gSalt m-2]. real, dimension(:,:), pointer :: TempxPmE => NULL() !< The net inflow of water into the ocean times the diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index a7ccd23d09..835a3ff450 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -322,10 +322,11 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) 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 - real :: S_min !< The minimum salinity - real :: mc !< A layer's mass kg m-2 . + real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement [gSalt m-2] + real :: S_min !< The minimum salinity [ppt]. + real :: mc !< A layer's mass [kg m-2]. integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo @@ -333,16 +334,15 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) ! call cpu_clock_begin(id_clock_adjust_salt) -!### MAKE THIS A RUN_TIME PARAMETER. COULD IT BE 0? - S_min = 0.01 + S_min = tv%min_salinity salt_add_col(:,:) = 0.0 !$OMP parallel do default(none) private(mc) do j=js,je do k=nz,1,-1 ; do i=is,ie - if ((G%mask2dT(i,j) > 0.0) .and. & - ((tv%S(i,j,k) < S_min) .or. (salt_add_col(i,j) > 0.0))) then + if ( (G%mask2dT(i,j) > 0.0) .and. & + ((tv%S(i,j,k) < S_min) .or. (salt_add_col(i,j) > 0.0)) ) then mc = GV%H_to_kg_m2 * h(i,j,k) if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be adjusted by the salt flux @@ -350,14 +350,12 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) salt_add_col(i,j) = salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) tv%S(i,j,k) = S_min endif + elseif (salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) <= 0.0) then + tv%S(i,j,k) = tv%S(i,j,k) - salt_add_col(i,j) / mc + salt_add_col(i,j) = 0.0 else - if (salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) <= 0.0) then - tv%S(i,j,k) = tv%S(i,j,k) - salt_add_col(i,j)/mc - salt_add_col(i,j) = 0.0 - else - salt_add_col(i,j) = salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) - tv%S(i,j,k) = S_min - endif + salt_add_col(i,j) = salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) + tv%S(i,j,k) = S_min endif endif enddo ; enddo @@ -1358,7 +1356,7 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori "be different than the ocean mask to avoid sea ice formation \n"//& "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & - "If true, apply additional mixing whereever there is \n"//& + "If true, apply additional mixing wherever there is \n"//& "runoff, so that it is mixed down to RIVERMIX_DEPTH \n"//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & From 550308ccc787ee9b4bbd575390e5e531c74fa6a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 May 2019 07:32:43 -0400 Subject: [PATCH 033/106] +Corrected documentation of HALF_STRAT_DEPTH Corrected documentation of HALF_STRAT_DEPTH written to MOM_parameter_doc files by Phillips_initialize_thickness. All answers are bitwise identical, but MOM_parameter_doc files change. --- src/user/Phillips_initialization.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index adfff7949f..395c5e2119 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -67,8 +67,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & -!### UNCOMMENT TO FIX THIS "The fractional depth where the stratification is centered.", & - "The maximum depth of the ocean.", & + "The fractional depth where the stratification is centered.", & units="nondim", default = 0.5, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & From d927495ebc152b9f6fc82ebc91fd346cc606bd6a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 May 2019 09:26:43 -0400 Subject: [PATCH 034/106] +Corrected spelling errors in documentation Corrected numerous spelling errors in comments, including the descriptions that are written to the MOM_parameter_doc files. All answers are bitwise identical, but there are numerous minor changes to the MOM_parameter_doc files. --- .../coupled_driver/MOM_surface_forcing.F90 | 2 +- config_src/mct_driver/MOM_ocean_model.F90 | 2 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 2 +- src/ALE/MOM_ALE.F90 | 4 ++-- src/ALE/MOM_regridding.F90 | 11 +++++----- src/ALE/coord_rho.F90 | 4 ++-- src/ALE/coord_sigma.F90 | 2 +- src/core/MOM_barotropic.F90 | 8 ++++---- src/core/MOM_continuity_PPM.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 4 ++-- src/equation_of_state/MOM_EOS.F90 | 2 +- src/framework/MOM_diag_mediator.F90 | 4 ++-- .../MOM_state_initialization.F90 | 6 +++--- src/parameterizations/lateral/MOM_MEKE.F90 | 20 +++++++++---------- .../lateral/MOM_hor_visc.F90 | 6 +++--- .../lateral/MOM_internal_tides.F90 | 4 ++-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 5 +++-- .../lateral/MOM_thickness_diffuse.F90 | 2 +- .../lateral/MOM_tidal_forcing.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 10 +++++----- .../vertical/MOM_set_viscosity.F90 | 6 +++--- src/parameterizations/vertical/MOM_sponge.F90 | 2 +- .../vertical/MOM_tidal_mixing.F90 | 10 +++++----- .../vertical/MOM_vert_friction.F90 | 2 +- src/tracer/MOM_tracer_hor_diff.F90 | 6 +++--- src/tracer/dye_example.F90 | 2 +- src/user/Idealized_Hurricane.F90 | 2 +- src/user/MOM_wave_interface.F90 | 4 ++-- 31 files changed, 71 insertions(+), 71 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 09d7da3119..2f806d778b 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1203,7 +1203,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE", CS%restore_temp, & "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperauture \n"//& + "heat flux that drives sea-surface temperature \n"//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 64ef660dbf..00645926a1 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -313,7 +313,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperauture \n"//& + "heat flux that drives sea-surface temperature \n"//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9889887b04..9f00994598 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -334,7 +334,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperauture \n"//& + "heat flux that drives sea-surface temperature \n"//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index f6c84dff5a..6793c73be2 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -177,7 +177,7 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) trim(remappingSchemesDoc), default=remappingDefaultScheme) call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & "If true, cell-by-cell reconstructions are checked for\n"//& - "consistency and if non-monotonicty or an inconsistency is\n"//& + "consistency and if non-monotonicity or an inconsistency is\n"//& "detected then a FATAL error is issued.", default=.false.) call get_param(param_file, mdl, "FATAL_CHECK_REMAPPING", check_remapping, & "If true, the results of remapping are checked for\n"//& @@ -215,7 +215,7 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) call get_param(param_file, mdl, "REGRID_FILTER_DEEP_DEPTH", filter_deep_depth, & "The depth below which full time-filtering is applied with time-scale\n"//& "REGRID_TIME_SCALE. Between depths REGRID_FILTER_SHALLOW_DEPTH and\n"//& - "REGRID_FILTER_SHALLOW_DEPTH the filter wieghts adopt a cubic profile.", & + "REGRID_FILTER_SHALLOW_DEPTH the filter weights adopt a cubic profile.", & units="m", default=0., scale=GV%m_to_H) call set_regrid_params(CS%regridCS, depth_of_time_filter_shallow=filter_shallow_depth, & depth_of_time_filter_deep=filter_deep_depth) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 2a1bcd5bcb..4dd05fd388 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -140,8 +140,8 @@ module MOM_regridding !> Documentation for coordinate options character(len=*), parameter, public :: regriddingCoordinateModeDoc = & " LAYER - Isopycnal or stacked shallow water layers\n"//& - " ZSTAR, Z* - stetched geopotential z*\n"//& - " SIGMA_SHELF_ZSTAR - stetched geopotential z* ignoring shelf\n"//& + " ZSTAR, Z* - stretched geopotential z*\n"//& + " SIGMA_SHELF_ZSTAR - stretched geopotential z* ignoring shelf\n"//& " SIGMA - terrain following coordinates\n"//& " RHO - continuous isopycnal\n"//& " HYCOM1 - HyCOM-like hybrid coordinate\n"//& @@ -230,8 +230,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (main_parameters) then ! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS) call get_param(param_file, mdl, "REGRIDDING_COORDINATE_UNITS", coord_units, & - "Units of the regridding coordinuate.",& !### Spelling error "coordinuate" - default=coordinateUnits(coord_mode)) + "Units of the regridding coordinate.", default=coordinateUnits(coord_mode)) else coord_units=coordinateUnits(coord_mode) endif @@ -420,7 +419,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) call log_param(param_file, mdl, "!TARGET_DENSITIES", rho_target, & - 'HYBRID target densities for itnerfaces', units=coordinateUnits(coord_mode)) + 'HYBRID target densities for interfaces', units=coordinateUnits(coord_mode)) endif elseif (index(trim(string),'WOA09')==1) then if (len_trim(string)==5) then @@ -503,7 +502,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (main_parameters .and. coord_is_state_dependent) then call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & "When interpolating potential density profiles we can add\n"//& - "some artificial compressibility solely to make homogenous\n"//& + "some artificial compressibility solely to make homogeneous\n"//& "regions appear stratified.", default=0.) call set_regrid_params(CS, compress_fraction=tmpReal) endif diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 452b3dfa09..74af5813eb 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -286,7 +286,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ zInterface(1) = 0. do k = 1,nz zInterface(k+1) = zInterface(k) - h1(k) - ! Adjust interface position to accomodate inflating layers + ! Adjust interface position to accommodate inflating layers ! without disturbing the interface above enddo else @@ -294,7 +294,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ zInterface(nz+1) = -depth do k = nz,1,-1 zInterface(k) = zInterface(k+1) + h1(k) - ! Adjust interface position to accomodate inflating layers + ! Adjust interface position to accommodate inflating layers ! without disturbing the interface above enddo endif diff --git a/src/ALE/coord_sigma.F90 b/src/ALE/coord_sigma.F90 index 3bf666ec52..19c3213996 100644 --- a/src/ALE/coord_sigma.F90 +++ b/src/ALE/coord_sigma.F90 @@ -72,7 +72,7 @@ subroutine build_sigma_column(CS, depth, totalThickness, zInterface) zInterface(CS%nk+1) = -depth do k = CS%nk,1,-1 zInterface(k) = zInterface(k+1) + (totalThickness * CS%coordinateResolution(k)) - ! Adjust interface position to accomodate inflating layers + ! Adjust interface position to accommodate inflating layers ! without disturbing the interface above if (zInterface(k) < (zInterface(k+1) + CS%min_thickness)) then zInterface(k) = zInterface(k+1) + CS%min_thickness diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 57914ad7c4..c06943eb20 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -199,7 +199,7 @@ module MOM_barotropic !! update at the start of a call to btstep. The !! default is 1. logical :: BT_project_velocity !< If true, step the barotropic velocity first - !! and project out the velocity tendancy by 1+BEBT + !! and project out the velocity tendency by 1+BEBT !! when calculating the transport. The default !! (false) is to use a predictor continuity step to !! find the pressure field, and then do a corrector @@ -3785,7 +3785,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", CS%BT_cont_bounds, & "If true, and BOUND_BT_CORRECTION is true, use the \n"//& "BT_cont_type variables to set limits determined by \n"//& - "MAXCFL_BT_CONT on the CFL number of the velocites \n"//& + "MAXCFL_BT_CONT on the CFL number of the velocities \n"//& "that are likely to be driven by the corrective mass fluxes.", & default=.true.) !, do_not_log=.not.CS%bound_BT_corr) call get_param(param_file, mdl, "ADJUST_BT_CONT", CS%adjust_BT_cont, & @@ -3846,7 +3846,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, units="nondim", default=1) call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& "If true, step the barotropic velocity first and project \n"//& - "out the velocity tendancy by 1+BEBT when calculating the \n"//& + "out the velocity tendency by 1+BEBT when calculating the \n"//& "transport. The default (false) is to use a predictor \n"//& "continuity step to find the pressure field, and then \n"//& "to do a corrector continuity step using a weighted \n"//& @@ -3917,7 +3917,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "barotropic steps.", default=.false.) call get_param(param_file, mdl, "BT_LINEAR_WAVE_DRAG", CS%linear_wave_drag, & "If true, apply a linear drag to the barotropic velocities, \n"//& - "using rates set by lin_drag_u & _vdivided by the depth of \n"//& + "using rates set by lin_drag_u & _v divided by the depth of \n"//& "the ocean. This was introduced to facilitate tide modeling.", & default=.false.) call get_param(param_file, mdl, "BT_WAVE_DRAG_FILE", wave_drag_file, & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 3f6b699b20..4740ce6ced 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -2264,7 +2264,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "SIMPLE_2ND_PPM_CONTINUITY", CS%simple_2nd, & "If true, CONTINUITY_PPM uses a simple 2nd order \n"//& "(arithmetic mean) interpolation of the edge values. \n"//& - "This may give better PV conservation propterties. While \n"//& + "This may give better PV conservation properties. While \n"//& "it formally reduces the accuracy of the continuity \n"//& "solver itself in the strongly advective limit, it does \n"//& "not reduce the overall order of accuracy of the dynamic \n"//& diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index a824553a84..31552948e1 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -50,7 +50,7 @@ module MOM_verticalGrid g_prime, & !< The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. Rlay !< The target coordinate value (potential density) in each layer [kg m-3]. integer :: nkml = 0 !< The number of layers at the top that should be treated - !! as parts of a homogenous region. + !! 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. @@ -100,7 +100,7 @@ subroutine verticalGridInit( param_file, GV, US ) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, & - "The minumum layer thickness, usually one-Angstrom.", & + "The minimum layer thickness, usually one-Angstrom.", & units="m", default=1.0e-10) call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, & "An integer power of 2 that is used to rescale the model's \n"//& diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index b06ffa0a79..7706b0391f 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1142,7 +1142,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points [Z ~> m]. real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations [Z ~> m]. real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m]. - real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. + real :: weight_t, weight_b ! Nondimensional weights of the top and bottom. real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [degC]. real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners [ppt]. diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 954bf48e90..13be17a53b 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -2944,8 +2944,8 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) 'Set the default missing value to use for diagnostics.', & default=1.e20) call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & - 'Instead of writing diagnostics to the diag manager, write\n' //& - 'a textfile containing the checksum (bitcount) of the array.', & + 'Instead of writing diagnostics to the diag manager, write\n'//& + 'a text file containing the checksum (bitcount) of the array.', & default=.false.) ! Keep pointers grid, h, T, S needed diagnostic remapping diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 32e7161b1e..6adf12028f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -229,8 +229,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! 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, intialize the layer thicknesses, temperatures, \n"//& - "and salnities from a Z-space file on a latitude- \n"//& + "If true, initialize the layer thicknesses, temperatures, \n"//& + "and salinities from a Z-space file on a latitude- \n"//& "longitude grid.", default=.false., do_not_log=just_read) if (from_Z_file) then @@ -447,7 +447,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & 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\n"//& - "at the depth where the hydrostatic presure matches the imposed\n"//& + "at the depth where the hydrostatic pressure matches the imposed\n"//& "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: "//& diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 87e78efe45..715cd4f318 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -865,7 +865,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "MEKE_DAMPING", CS%MEKE_damping, & - "The local depth-indepented MEKE dissipation rate.", & + "The local depth-independent MEKE dissipation rate.", & units="s-1", default=0.0) call get_param(param_file, mdl, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & "The ratio of the bottom eddy velocity to the column mean\n"//& @@ -944,41 +944,41 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & "If positive, is a fixed length contribution to the expression\n"//& - "for mixing length used in MEKE-derived diffusiviity.", & + "for mixing length used in MEKE-derived diffusivity.", & units="m", default=0.0) call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, & "If positive, is a coefficient weighting the deformation scale\n"//& - "in the expression for mixing length used in MEKE-derived diffusiviity.", & + "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_ALPHA_RHINES", CS%aRhines, & "If positive, is a coefficient weighting the Rhines scale\n"//& - "in the expression for mixing length used in MEKE-derived diffusiviity.", & + "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.05) call get_param(param_file, mdl, "MEKE_ALPHA_EADY", CS%aEady, & "If positive, is a coefficient weighting the Eady length scale\n"//& - "in the expression for mixing length used in MEKE-derived diffusiviity.", & + "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.05) call get_param(param_file, mdl, "MEKE_ALPHA_FRICT", CS%aFrict, & "If positive, is a coefficient weighting the frictional arrest scale\n"//& - "in the expression for mixing length used in MEKE-derived diffusiviity.", & + "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_ALPHA_GRID", CS%aGrid, & "If positive, is a coefficient weighting the grid-spacing as a scale\n"//& - "in the expression for mixing length used in MEKE-derived diffusiviity.", & + "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_COLD_START", coldStart, & "If true, initialize EKE to zero. Otherwise a local equilibrium solution\n"//& "is used as an initial condition for EKE.", default=.false.) call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_C", MEKE%backscatter_Ro_c, & - "The coefficient in the Rossby number function for scaling the buharmonic\n"//& + "The coefficient in the Rossby number function for scaling the biharmonic\n"//& "frictional energy source. Setting to non-zero enables the Rossby number function.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_POW", MEKE%backscatter_Ro_pow, & - "The power in the Rossby number function for scaling the biharmomnic\n"//& + "The power in the Rossby number function for scaling the biharmonic\n"//& "frictional energy source.", units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_ADVECTION_FACTOR", CS%MEKE_advection_factor, & "A scale factor in front of advection of eddy energy. Zero turns advection off.\n"//& - "Using unity would be normal but other values could accomodate a mismatch\n"//& + "Using unity would be normal but other values could accommodate a mismatch\n"//& "between the advecting barotropic flow and the vertical structure of MEKE.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_TOPOGRAPHIC_BETA", CS%MEKE_topographic_beta, & diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 5387e0fa8b..2c4bb99ae9 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -417,7 +417,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - ! There are extra wide halos here to accomodate the cross-corner-point + ! There are extra wide halos here to accommodate the cross-corner-point ! OBC projections, but they might not be necessary if the accelerations ! are always zeroed out at OBC points, in which case the i-loop below ! becomes do i=is-1,ie+1. -RWH @@ -1063,12 +1063,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "viscosity, the Smagorinsky and Leith viscosities, and KH.", & units="m s-1", default=0.0) call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & - "The amplitude of a latidutinally-dependent background\n"//& + "The amplitude of a latitudinally-dependent background\n"//& "viscosity of the form KH_SIN_LAT*(SIN(LAT)**KH_PWR_OF_SINE).", & units = "m2 s-1", default=0.0) if (Kh_sin_lat>0. .or. get_all) & call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & - "The power used to raise SIN(LAT) when using a latidutinally-\n"//& + "The power used to raise SIN(LAT) when using a latitudinally-\n"//& "dependent background viscosity.", & units = "nondim", default=4.0) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 4850770f26..2f7e85701b 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1808,7 +1808,7 @@ subroutine teleport(En, NAngle, CS, G, LB) end subroutine teleport -!> Rotates points in the halos where required to accomodate +!> Rotates points in the halos where required to accommodate !! changes in grid orientation, such as at the tripolar fold. subroutine correct_halo_rotation(En, test, G, NAngle) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -2239,7 +2239,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_TIDE_SIMPLE_2ND_PPM", CS%simple_2nd, & "If true, CONTINUITY_PPM uses a simple 2nd order \n"//& "(arithmetic mean) interpolation of the edge values. \n"//& - "This may give better PV conservation propterties. While \n"//& + "This may give better PV conservation properties. While \n"//& "it formally reduces the accuracy of the continuity \n"//& "solver itself in the strongly advective limit, it does \n"//& "not reduce the overall order of accuracy of the dynamic \n"//& diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 1182ce94e7..5c005740ae 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -933,11 +933,12 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& "When INTERPOLATE_RES_FN=True, VISC_RES_FN_POWER must equal KH_RES_FN_POWER.") endif + !### Change the default of GILL_EQUATORIAL_LD to True. call get_param(param_file, mdl, "GILL_EQUATORIAL_LD", Gill_equatorial_Ld, & "If true, uses Gill's definition of the baroclinic\n"//& "equatorial deformation radius, otherwise, if false, use\n"//& - "Pedlosky's definition. These definitions differ by a factor\n"//& - "of 2 infront of the beta term in the denominator. Gill's"//& + "Pedlosky's definition. These definitions differ by a factor \n"//& + "of 2 in front of the beta term in the denominator. Gill's \n"//& "is the more appropriate definition.\n", default=.false.) if (Gill_equatorial_Ld) then oneOrTwo = 2.0 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 802e26a404..2883afda05 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1742,7 +1742,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) if (CS%max_Khth_CFL < 0.0) CS%max_Khth_CFL = 0.0 call get_param(param_file, mdl, "DETANGLE_INTERFACES", CS%detangle_interfaces, & "If defined add 3-d structured enhanced interface height \n"//& - "diffusivities to horizonally smooth jagged layers.", & + "diffusivities to horizontally smooth jagged layers.", & default=.false.) CS%detangle_time = 0.0 if (CS%detangle_interfaces) & diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 075c69ed65..156cd0ff54 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -201,7 +201,7 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) if (nc > MAX_CONSTITUENTS) then write(mesg,'("Increase MAX_CONSTITUENTS in MOM_tidal_forcing.F90 to at least",I3, & - &"to accomodate all the registered tidal constituents.")') nc + &"to accommodate all the registered tidal constituents.")') nc call MOM_error(FATAL, "MOM_tidal_forcing"//mesg) endif diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index be7d0ff08b..fefb4e8daf 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -3544,7 +3544,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "heating depth of an exponential profile by moving some \n"//& "of the heating upward in the water column.", default=.false.) call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & - "If true, apply additional mixing whereever there is \n"//& + "If true, apply additional mixing wherever there is \n"//& "runoff, so that it is mixed down to RIVERMIX_DEPTH, \n"//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index b171570f8e..7f8d08fb48 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2136,7 +2136,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "decreases the PBL diffusivity.", units="nondim", default=1.0) call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & "A logical that specifies whether or not to use the \n"// & - "distance to the bottom of the actively turblent boundary \n"//& + "distance to the bottom of the actively turbulent boundary \n"//& "layer to help set the EPBL length scale.", default=.false.) call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & "A logical that specifies whether or not to use the \n"// & diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 111e8d44e2..f1276be827 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -316,7 +316,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & - "The maximum internal tide energy source availble to mix \n"//& + "The maximum internal tide energy source available to mix \n"//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & units="W m-2", default=1.0e3) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 962a9d07c2..24180b62e5 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -103,7 +103,7 @@ module MOM_set_diffusivity !! decay scale determined by the minimum of !! (1) The depth of the mixed layer, or !! (2) An Ekman length scale. - !! Energy availble to drive mixing below the mixed layer is + !! Energy available to drive mixing below the mixed layer is !! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if !! ML_rad_TKE_decay is true, this is further reduced by a factor !! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is @@ -2045,7 +2045,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the \n"//& "BBL mixing and the other diffusivities. Otherwise, \n"//& - "diffusiviy from the BBL_mixing is simply added.", & + "diffusivity from the BBL_mixing is simply added.", & default=.true.) call get_param(param_file, mdl, "USE_LOTW_BBL_DIFFUSIVITY", CS%use_LOTW_BBL_diffusivity, & "If true, uses a simple, imprecise but non-coordinate dependent, model\n"//& @@ -2064,7 +2064,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z 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\n"//& "work for arbitrary vertical coordinates. If false,\n"//& - "calculates Kd/TKE and bounds based on exact energetics/n"//& + "calculates Kd/TKE and bounds based on exact energetics\n"//& "for an isopycnal layer-formulation.", & default=.false.) @@ -2179,8 +2179,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z endif call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & + "If true, increase diffusivites for temperature or salt \n"//& + "based on double-diffusive parameterization from MOM4/KPP.", & default=.false.) if (CS%double_diffusion) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 75782be0d0..b4c4abb870 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1837,8 +1837,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (.not.adiabatic) then CS%RiNo_mix = kappa_shear_is_used(param_file) call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & + "If true, increase diffusivites for temperature or salt \n"//& + "based on double-diffusive parameterization from MOM4/KPP.", & default=.false.) use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) endif @@ -1941,7 +1941,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "ADD_KV_SLOW", visc%add_Kv_slow, & "If true, the background vertical viscosity in the interior \n"//& - "(i.e., tidal + background + shear + convenction) is addded \n"// & + "(i.e., tidal + background + shear + convection) is added \n"// & "when computing the coupling coefficient. The purpose of this \n"// & "flag is to be able to recover previous answers and it will likely \n"// & "be removed in the future since this option should always be true.", & diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index eaa2faf765..af151cbf38 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -188,7 +188,7 @@ end subroutine initialize_sponge !> This subroutine sets up diagnostics for the sponges. It is separate !! from initialize_sponge because it requires fields that are not readily -!! availble where initialize_sponge is called. +!! available where initialize_sponge is called. subroutine init_sponge_diags(Time, G, diag, CS) type(time_type), target, intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 6f85bc5dbe..8b5880fbb1 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -298,7 +298,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& "\t decay profile.\n"//& - "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& + "\t POLZIN_09 - Use the Polzin WKB-stretched algebraic \n"//& "\t decay profile.", & default=STLAURENT_PROFILE_STRING) int_tide_profile_str = uppercase(int_tide_profile_str) @@ -332,7 +332,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ "dissipation with LEE_WAVE_DISSIPATION. Valid values are:\n"//& "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& "\t decay profile.\n"//& - "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& + "\t POLZIN_09 - Use the Polzin WKB-stretched algebraic \n"//& "\t decay profile.", & default=STLAURENT_PROFILE_STRING) tmpstr = uppercase(tmpstr) @@ -365,7 +365,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ units="nondim", default=0.0697) call get_param(param_file, mdl, "NBOTREF_POLZIN", CS%Nbotref_Polzin, & "When the Polzin decay profile is used, this is the \n"//& - "Rreference value of the buoyancy frequency at the ocean \n"//& + "reference value of the buoyancy frequency at the ocean \n"//& "bottom in the Polzin formulation for the vertical \n"//& "scale of decay for the tidal energy dissipation.", & units="s-1", default=9.61e-4) @@ -425,10 +425,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & - "A scaling factor for the roughness amplitude with n"//& + "A scaling factor for the roughness amplitude with \n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & - "The maximum internal tide energy source availble to mix \n"//& + "The maximum internal tide energy source available to mix \n"//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & units="W m-2", default=1.0e3) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index cfcd5ec6c3..4d32974bfa 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1696,7 +1696,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "to be reported; the default is CFL_TRUNCATE.", & units="nondim", default=CS%CFL_trunc) call get_param(param_file, mdl, "CFL_TRUNCATE_RAMP_TIME", CS%truncRampTime, & - "The time over which the CFL trunction value is ramped\n"//& + "The time over which the CFL truncation value is ramped\n"//& "up at the beginning of the run.", & units="s", default=0.) CS%CFL_truncE = CS%CFL_trunc diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 48ec698696..50164bb3c3 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -1415,13 +1415,13 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) units="m2 s-1", default=0.0) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & "The coefficient that scales deformation radius over \n"//& - "grid-spacing in passivity, where passiviity is the ratio \n"//& - "between along isopycnal mxiing of tracers to thickness mixing. \n"//& + "grid-spacing in passivity, where passivity is the ratio \n"//& + "between along isopycnal mixing of tracers to thickness mixing. \n"//& "A non-zero value enables this parameterization.", & units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_PASSIVITY_MIN", CS%KhTr_passivity_min, & "The minimum passivity which is the ratio between \n"//& - "along isopycnal mxiing of tracers to thickness mixing. \n", & + "along isopycnal mixing of tracers to thickness mixing. \n", & units="nondim", default=0.5) call get_param(param_file, mdl, "DIFFUSE_ML_TO_INTERIOR", CS%Diffuse_ML_interior, & "If true, enable epipycnal mixing between the surface \n"//& diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 51b5ab6c08..899d0cee67 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -140,7 +140,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) CS%dye_source_mindepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, & - "This is the minumum depth at which we inject dyes.", & + "This is the minimum depth at which we inject dyes.", & units="m", scale=US%m_to_Z, fail_if_missing=.true.) if (minval(CS%dye_source_mindepth(:)) < -1.e29*US%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH") diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index efd75810d6..b24ddc10cf 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -34,7 +34,7 @@ module Idealized_hurricane #include -public idealized_hurricane_wind_init !Public interface to intialize the idealized +public idealized_hurricane_wind_init !Public interface to initialize the idealized ! hurricane wind profile. public idealized_hurricane_wind_forcing !Public interface to update the idealized ! hurricane wind profile. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index c3a262ad92..d08c9f42ca 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -352,7 +352,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & "The depth (normalized by BLD) to average Stokes drift over in \n"//& - " Lanmguir number calculation, where La = sqrt(ust/Stokes).", & + " Langmuir number calculation, where La = sqrt(ust/Stokes).", & units="nondim",default=0.04) call get_param(param_file, mdl, "LA_MISALIGNMENT", LA_Misalignment, & "Flag (logical) if using misalignment bt shear and waves in LA",& @@ -408,7 +408,7 @@ subroutine MOM_wave_interface_init_lite(param_file) ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & "The depth (normalized by BLD) to average Stokes drift over in \n"//& - " Lanmguir number calculation, where La = sqrt(ust/Stokes).", & + " Langmuir number calculation, where La = sqrt(ust/Stokes).", & units="nondim",default=0.04) if (WaveMethod==NULL_WaveMethod) then From 3c2f250d221b1e1e2f3df10528d167d963d34890 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 7 May 2019 10:59:10 -0400 Subject: [PATCH 035/106] MOM_set_diffusivity: dissip scaling Dissipation parameters are now fully rescaled with respect to time: * DISSIPATION_MIN * DISSIPATION_N[012] as are internal dissipation variables. --- .../vertical/MOM_set_diffusivity.F90 | 28 ++++++++++--------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 1fa0732f54..6bc510889a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -89,10 +89,10 @@ module MOM_set_diffusivity logical :: limit_dissipation !< If enabled, dissipation is limited to be larger !! than the following: - real :: dissip_min !< Minimum dissipation [Z2 m-2 W m-3 ~> W m-3] - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [Z2 m-2 W m-3 ~> W m-3] - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [Z2 m-2 W m-3 T ~> J m-3] - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [Z2 m-2 W m-3 T2 ~> J s m-3] + real :: dissip_min !< Minimum dissipation [kg Z2 m-3 T-3 ~> W m-3] + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [kg Z2 m-3 T-3 ~> W m-3] + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [kg Z2 m-3 T-2 ~> J m-3] + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [kg Z2 m-3 T-1 ~> J s m-3] real :: dissip_Kd_min !< Minimum Kd [Z2 T-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion [W m-2] @@ -256,7 +256,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & KS_extra !< double difusion diffusivity of salinity [Z2 s-1 ~> m2 s-1] real :: I_Rho0 ! inverse of Boussinesq density [m3 kg-1] - real :: dissip ! local variable for dissipation calculations [Z2 W m-5 ~> W m-3] + real :: dissip ! local variable for dissipation calculations [Z2 kg m-3 T-3 ~> W m-3] real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2] logical :: use_EOS ! If true, compute density from T/S using equation of state. @@ -507,16 +507,16 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & dissip = max( CS%dissip_min, & ! Const. floor on dissip. CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k)) ! Floor of Kd_min*rho0/F_Ri - Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * ((US%s_to_T**2 * N2_lay(i,k)) + (US%s_to_T**2 * Omega2)))) ) + Kd_lay(i,j,k) = max(Kd_lay(i,j,k) , & ! Apply floor to Kd + US%s_to_T * dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2)))) enddo ; enddo if (present(Kd_int)) then ; 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(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * ((US%s_to_T**2 * N2_int(i,K)) + (US%s_to_T**2 * Omega2)))) ) + Kd_int(i,j,K) = max(Kd_int(i,j,K) , & ! Apply floor to Kd + US%s_to_T * dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) enddo ; enddo ; endif endif @@ -2125,17 +2125,19 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower \n"//& - "bound of Kd (a floor).", units="W m-3", default=0.0, scale=US%m_to_Z**2) + "bound of Kd (a floor).", units="W m-3", default=0.0, & + scale=(US%m_to_Z**2)*(US%T_to_s**3)) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression \n"//& "used to set a minimum dissipation by which to determine \n"//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & - units="W m-3", default=0.0, scale=US%m_to_Z**2) + units="W m-3", default=0.0, & + scale=(US%m_to_Z**2)*(US%T_to_s)**3) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0, scale=(US%m_to_Z**2)*US%s_to_T) + units="J m-3", default=0.0, scale=(US%m_to_Z**2)*(US%T_to_s**2)) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & units="m2 s-1", default=0.0, scale=(US%m_to_Z**2)*US%T_to_s) @@ -2144,7 +2146,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) CS%dissip_N2 = 0.0 if (CS%FluxRi_max > 0.0) & - CS%dissip_N2 = US%s_to_T**3 * CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max + CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=US%Z_to_m**2) From c6580ed36b6e085119eac441bd3e720a37a7e25e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 7 May 2019 17:08:28 -0400 Subject: [PATCH 036/106] MOM_set_diffusivity scaling: N2, Kd_work diags Dimensional scaling support for the N2 and Kd_work diagnostics in the MOM_set_diffusivity module, as wel as a hN2pO2 internal variable. --- .../vertical/MOM_set_diffusivity.F90 | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 6bc510889a..b259606253 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -170,10 +170,10 @@ module MOM_set_diffusivity !> This structure has memory for used in calculating diagnostics of diffusivity type diffusivity_diags real, pointer, dimension(:,:,:) :: & - N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [s-2] + N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [T-2 ~> s-2] Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 s-1 ~> m2 s-1] Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 s-1 ~> m2 s-1] - Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [W m-2] + Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [kg T-3 ~> W m-2] maxTKE => NULL(), & !< energy required to entrain to h_max [m3 s-3] KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 s-1 ~> m2 s-1]. KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 s-1 ~> m2 s-1]. @@ -401,7 +401,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, N2_lay, N2_int, N2_bot) if (associated(dd%N2_3d)) then - do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = US%s_to_T**2 * N2_int(i,K) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo endif ! Add background mixing @@ -522,7 +522,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * (US%Z_to_m**3 * Kd_lay(i,j,k)) * (US%s_to_T**2 * N2_lay(i,k)) * & + dd%Kd_Work(i,j,k) = GV%Rho0 * (US%Z_to_m**3 * US%T_to_s * Kd_lay(i,j,k)) * N2_lay(i,k) * & GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3 enddo ; enddo endif @@ -714,7 +714,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] real :: I_dt ! 1/dt [s-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] - real :: hN2pO2 ! h (N^2 + Omega^2), in [m3 s-2 Z-2 ~> m s-2]. + real :: hN2pO2 ! h (N^2 + Omega^2), in [m3 T-2 Z-2 ~> m s-2]. logical :: do_i(SZI_(G)) integer :: i, k, is, ie, nz, i_rem, kmb, kb_min @@ -729,13 +729,13 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ((US%s_to_T**2 * N2_lay(i,k)) + (US%s_to_T**2 * Omega2)) ! Units of m3 Z-2 s-2. + hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * (N2_lay(i,k) + Omega2) ! Units of m3 Z-2 T-2. if (hN2pO2>0.) then - TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. + TKE_to_Kd(i,k) = 1.0 / (US%s_to_T**2 * hN2pO2) ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of m3 s-3. + maxTKE(i,k) = (US%s_to_T**2 * hN2pO2) * CS%Kd_max ! Units of m3 s-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -2156,7 +2156,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%tm_csp%Lowmode_itidal_dissipation) then CS%id_Kd_Work = register_diag_field('ocean_model', 'Kd_Work', diag%axesTL, Time, & - 'Work done by Diapycnal Mixing', 'W m-2') + 'Work done by Diapycnal Mixing', 'W m-2', conversion=US%s_to_T**3) CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & 'Maximum layer TKE', 'm3 s-3') CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & @@ -2164,7 +2164,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency', & - cmor_standard_name='square_of_brunt_vaisala_frequency_in_sea_water') + cmor_standard_name='square_of_brunt_vaisala_frequency_in_sea_water', & + conversion=US%s_to_T**2) if (CS%user_change_diff) & CS%id_Kd_user = register_diag_field('ocean_model', 'Kd_user', diag%axesTi, Time, & From be7a4168900b0530b246a0017be8f4655a023cd7 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 8 May 2019 09:26:07 -0400 Subject: [PATCH 037/106] MOM_set_diffusivity: TKE_to_Kd time rescaling --- .../vertical/MOM_set_diffusivity.F90 | 49 ++++++++++--------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b259606253..6ce15effe8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -482,7 +482,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - call calculate_tidal_mixing(h, US%s_to_T**2 * N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tm_csp, & + call calculate_tidal_mixing(h, US%s_to_T**2 * N2_bot, j, US%T_to_s**2 * TKE_to_Kd, maxTKE, G, GV, US, CS%tm_csp, & US%s_to_T**2 * N2_lay, US%s_to_T**2 * N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow @@ -674,11 +674,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & integer, intent(in) :: j !< j-index of row to work on real, intent(in) :: dt !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd !< The conversion rate between the TKE - !! TKE dissipated within a layer and the + real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd !< The conversion rate between the + !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] + !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [m3 s-3] integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer @@ -729,9 +729,9 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * (N2_lay(i,k) + Omega2) ! Units of m3 Z-2 T-2. + hN2pO2 = US%Z_to_m**3 * (GV%H_to_Z * h(i,j,k)) * (N2_lay(i,k) + Omega2) ! Units of m3 Z-2 T-2. if (hN2pO2>0.) then - TKE_to_Kd(i,k) = 1.0 / (US%s_to_T**2 * hN2pO2) ! Units of Z2 s2 m-3. + TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. @@ -830,7 +830,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & enddo do k=2,kmb ; do i=is,ie maxTKE(i,k) = 0.0 - TKE_to_Kd(i,k) = US%m_to_Z**3 / (((US%s_to_T**2 * N2_lay(i,k)) + (US%s_to_T**2 * Omega2)) * & + TKE_to_Kd(i,k) = US%m_to_Z**3 / ((N2_lay(i,k) + Omega2) * & (GV%H_to_Z*(h(i,j,k) + H_neglect))) enddo ; enddo do k=kmb+1,kb_min-1 ; do i=is,ie @@ -854,8 +854,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & maxTKE(i,k) = I_dt*US%Z_to_m * ((GV%g_Earth * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) - TKE_to_Kd(i,k) = US%m_to_Z**3 / ((US%s_to_T**2 * G_Rho0) * dRho_lay + & - (US%s_to_T**2 * CS%omega**2) * GV%H_to_Z*(h(i,j,k) + H_neglect)) + TKE_to_Kd(i,k) = US%m_to_Z**3 / (G_Rho0 * dRho_lay + & + CS%omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif enddo ; enddo @@ -1148,7 +1148,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] + !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness [m3 s-3] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer @@ -1303,13 +1303,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd_lay(i,j,k) + if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k))) then + delta_Kd = (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k)) - Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_max Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else - Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) + Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k)) endif Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd @@ -1319,12 +1319,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd_lay(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then + if (Kd_lay(i,j,k) >= maxTKE(i,k)*(US%T_to_s**2 * TKE_to_Kd(i,k))) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > & - maxTKE(i,k)*TKE_to_Kd(i,k)) then - TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/TKE_to_Kd(i,k) ) - & + elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k)) > & + maxTKE(i,k)*(US%T_to_s**2 * TKE_to_Kd(i,k))) then + TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/(US%T_to_s**2 * TKE_to_Kd(i,k)) ) - & maxTKE(i,k) TKE(i) = TKE(i) - TKE_here + TKE_Ray else @@ -1334,7 +1334,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = TKE_here * TKE_to_Kd(i,k) + delta_Kd = TKE_here * (US%T_to_s**2 * TKE_to_Kd(i,k)) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd @@ -1541,7 +1541,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] + !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces !! [Z2 s-1 ~> m2 s-1]. @@ -1605,10 +1605,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, ! a more accurate Taylor series approximations for very thin layers. z1 = (GV%H_to_Z*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,kml+1))) * & (1.0 - exp(-z1)) else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,kml+1))) * & (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) @@ -1632,10 +1632,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,k))) * & US%m_to_Z * ((1.0 - exp(-z1)) / dzL) else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,k))) * & US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) @@ -2160,7 +2160,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & 'Maximum layer TKE', 'm3 s-3') CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & - 'Convert TKE to Kd', 's2 m', conversion=US%Z_to_m**2) + 'Convert TKE to Kd', 's2 m', & + conversion=(US%Z_to_m**2)*(US%T_to_s**2)) CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency', & From 7bb53657f9b6d2cce5da2f046d92084aa179df33 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 8 May 2019 10:30:31 -0400 Subject: [PATCH 038/106] MOM_set_diffusivity: scaling of ML radiation terms Time rescaling of internal variables for add_MLrad_diffusivity, including the following parameter: * ML_RAD_KD_MAX --- .../vertical/MOM_set_diffusivity.F90 | 55 ++++++++++--------- 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 6ce15effe8..ec58643a27 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1549,14 +1549,14 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, ! This routine adds effects of mixed layer radiation to the layer diffusivities. real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness [Z ~> m]. - real, dimension(SZI_(G)) :: TKE_ml_flux + real, dimension(SZI_(G)) :: TKE_ml_flux ! Mixed layer TKE flux [Z3 T-3 ~> m3 s-3] real, dimension(SZI_(G)) :: I_decay ! A decay rate [Z-1 ~> m-1]. - real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation [Z2 s-1 ~> m2 s-1]. + real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation [Z2 T-1 ~> m2 s-1]. - real :: f_sq ! The square of the local Coriolis parameter or a related variable [s-2]. + real :: f_sq ! The square of the local Coriolis parameter or a related variable [T-2 ~> s-2]. real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2]. - real :: ustar_sq ! ustar squared [Z2 s-2 ~> m2 s-2] - real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 s-1 ~> m2 s-1]. + real :: ustar_sq ! ustar squared [Z2 T-2 ~> m2 s-2] + real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 T-1 ~> m2 s-1]. real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared [T-2 ~> s-2]. real :: z1 ! layer thickness times I_decay [nondim] @@ -1581,17 +1581,18 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then if (CS%ML_omega_frac >= 1.0) then - f_sq = 4.0*(US%s_to_T**2 * Omega2) + f_sq = 4.0 * Omega2 else - f_sq = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f_sq = 0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) if (CS%ML_omega_frac > 0.0) & - f_sq = CS%ML_omega_frac*4.0*(US%s_to_T**2 * Omega2) + (1.0-CS%ML_omega_frac)*f_sq + f_sq = CS%ML_omega_frac * 4.0 * Omega2 + (1.0 - CS%ML_omega_frac) * f_sq endif - ustar_sq = max(fluxes%ustar(i,j), US%s_to_T * CS%ustar_min)**2 + ustar_sq = max(US%T_to_s * fluxes%ustar(i,j), CS%ustar_min)**2 - TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(US%Z_to_m**3*ustar_sq*fluxes%ustar(i,j)) + TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) & + * (US%Z_to_m**3 * ustar_sq * (US%T_to_s * fluxes%ustar(i,j))) I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) if (CS%ML_rad_TKE_decay) & @@ -1605,25 +1606,24 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, ! a more accurate Taylor series approximations for very thin layers. z1 = (GV%H_to_Z*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,kml+1))) * & - (1.0 - exp(-z1)) + Kd_mlr = TKE_ml_flux(i) * TKE_to_Kd(i,kml+1) * (1.0 - exp(-z1)) else - Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,kml+1))) * & - (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) + Kd_mlr = TKE_ml_flux(i) * TKE_to_Kd(i,kml+1) & + * (z1 * (1.0 - z1 * (0.5 - C1_6 * z1))) endif Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) endif ; enddo do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr_ml(i) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%s_to_T * Kd_mlr_ml(i)) endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_mlr_ml(i) + Kd_int(i,j,K) = Kd_int(i,j,K) + (US%s_to_T * Kd_mlr_ml(i)) endif ; enddo ; enddo if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*Kd_mlr_ml(i) + Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5 * (US%s_to_T * Kd_mlr_ml(i)) endif ; enddo ; endif endif @@ -1632,21 +1632,21 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,k))) * & - US%m_to_Z * ((1.0 - exp(-z1)) / dzL) + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) & + * US%m_to_Z * ((1.0 - exp(-z1)) / dzL) else - Kd_mlr = (TKE_ml_flux(i) * (US%T_to_s**2 * TKE_to_Kd(i,k))) * & - US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) & + * US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%s_to_T * Kd_mlr) if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * Kd_mlr) + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%s_to_T * Kd_mlr) endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*US%Z_to_m**3*(US%s_to_T**2 * Omega2)) then + if ((US%s_to_T**3 * TKE_ml_flux(i)) * I_decay(i) < 0.1*CS%Kd_min*US%Z_to_m**3*(US%s_to_T**2 * Omega2)) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -1984,7 +1984,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "The maximum diapycnal diffusivity due to turbulence \n"//& "radiated from the base of the mixed layer. \n"//& "This is only used if ML_RADIATION is true.", & - units="m2 s-1", default=1.0e-3, scale=US%m_to_Z**2) + units="m2 s-1", default=1.0e-3, & + scale=(US%m_to_Z**2)*(US%T_to_s)) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& "the energy available for mixing below the base of the \n"//& From 50a14bf741abe2191b75e4d18ecc6e1c72527f13 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 8 May 2019 15:38:55 -0400 Subject: [PATCH 039/106] MOM_set_diffusivity: maxTKE time scaling The calculation of maxTKE is rescaled inside set_diffusivity, along with various other internal variables. add_drag_diffusivity not yet scaled. --- .../vertical/MOM_set_diffusivity.F90 | 55 ++++++++++--------- 1 file changed, 30 insertions(+), 25 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index ec58643a27..09c070e271 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -180,7 +180,7 @@ module MOM_set_diffusivity real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE !! dissipated within a layer and Kd in that layer - !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] + !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> T2 m-1] end type diffusivity_diags @@ -244,10 +244,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZK_(G)) :: & N2_lay, & !< squared buoyancy frequency associated with layers [T-2 ~> s-2] - maxTKE, & !< energy required to entrain to h_max [m3 s-3] + maxTKE, & !< energy required to entrain to h_max [m3 T-3] TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between - !< TKE dissipated within a layer and Kd in that layer, in - !< m2 s-1 / m3 s-3 = [s2 m-1]. + !< TKE dissipated within a layer and Kd in that layer + !< [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] @@ -468,7 +468,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif endif - call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, TKE_to_Kd, & + call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, US%s_to_T * dt, G, GV, US, CS, TKE_to_Kd, & maxTKE, kb) if (associated(dd%maxTKE)) then ; do k=1,nz ; do i=is,ie dd%maxTKE(i,j,k) = maxTKE(i,k) @@ -482,7 +482,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - call calculate_tidal_mixing(h, US%s_to_T**2 * N2_bot, j, US%T_to_s**2 * TKE_to_Kd, maxTKE, G, GV, US, CS%tm_csp, & + call calculate_tidal_mixing(h, US%s_to_T**2 * N2_bot, j, US%T_to_s**2 * TKE_to_Kd, US%s_to_T**3 * maxTKE, G, GV, US, CS%tm_csp, & US%s_to_T**2 * N2_lay, US%s_to_T**2 * N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow @@ -493,7 +493,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & Kd_lay, Kd_int, dd%Kd_BBL) else call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) + US%s_to_T**3 * maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -672,7 +672,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. integer, intent(in) :: j !< j-index of row to work on - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd !< The conversion rate between the !! TKE dissipated within a layer and the @@ -680,7 +680,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [m3 s-3] + !! to its maximum realizable thickness [m3 T-3] integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. ! Local variables @@ -711,8 +711,9 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real :: dRho_lay ! density change across a layer [kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 T-2 kg-1 -> m4 s-2 kg-1] + real :: G_IRho0 ! ### Alternate calculation of G_Rho0 for reproducibility real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] - real :: I_dt ! 1/dt [s-1] + real :: I_dt ! 1/dt [T-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] real :: hN2pO2 ! h (N^2 + Omega^2), in [m3 T-2 Z-2 ~> m s-2]. logical :: do_i(SZI_(G)) @@ -720,11 +721,15 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & integer :: i, k, is, ie, nz, i_rem, kmb, kb_min is = G%isc ; ie = G%iec ; nz = G%ke - I_dt = 1.0/dt + I_dt = 1.0 / dt Omega2 = CS%omega**2 - G_Rho0 = (GV%g_Earth*US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 H_neglect = GV%H_subroundoff - I_Rho0 = 1.0/GV%Rho0 + ! ### G_Rho0 and G_IRho0 are mathematically identical but give different + ! numerical values. We compute both values for now, but they should be + ! consolidated at some point. + G_Rho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 + I_Rho0 = 1.0 / GV%Rho0 + G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then @@ -735,7 +740,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = (US%s_to_T**2 * hN2pO2) * CS%Kd_max ! Units of m3 s-3. + maxTKE(i,k) = hN2pO2 * (US%T_to_s * CS%Kd_max) ! Units of m3 T-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -851,7 +856,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) - maxTKE(i,k) = I_dt*US%Z_to_m * ((GV%g_Earth * I_Rho0) * & + maxTKE(i,k) = US%Z_to_m**3 * I_dt * (G_IRho0 * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) TKE_to_Kd(i,k) = US%m_to_Z**3 / (G_Rho0 * dRho_lay + & @@ -1150,7 +1155,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [m3 s-3] + !! to its maximum-realizable thickness [m3 s-3] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure @@ -1182,9 +1187,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real :: TKE_here ! TKE that goes into mixing in this layer [m3 s-3] real :: dRl, dRbot ! temporaries holding density differences [kg m-3] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] - real :: ustar_h ! value of ustar at a thickness point [Z s-1 ~> m s-1]. - real :: absf ! average absolute Coriolis parameter around a thickness point [s-1] - real :: R0_g ! Rho0 / G_Earth [kg s2 Z-1 m-4 ~> kg s2 m-5] + 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 [kg T2 Z-1 m-4 ~> kg s2 m-5] real :: I_rho0 ! 1 / RHO0 [m3 kg-1] real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 s-1 ~> m2 s-1]. logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities @@ -1206,7 +1211,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0 / (US%m_to_Z**2*GV%g_Earth) + R0_g = GV%Rho0 / (US%m_to_Z**2 * US%T_to_s**2 * GV%g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1216,11 +1221,11 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = visc%ustar_BBL(i,j) + ustar_h = (US%T_to_s * visc%ustar_BBL(i,j)) if (associated(fluxes%ustar_tidal)) & - ustar_h = ustar_h + US%m_to_Z*fluxes%ustar_tidal(i,j) - absf = 0.25 * US%s_to_T * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) + ustar_h = ustar_h + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) + absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then I2decay(i) = absf / ustar_h else @@ -2159,7 +2164,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%id_Kd_Work = register_diag_field('ocean_model', 'Kd_Work', diag%axesTL, Time, & 'Work done by Diapycnal Mixing', 'W m-2', conversion=US%s_to_T**3) CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & - 'Maximum layer TKE', 'm3 s-3') + 'Maximum layer TKE', 'm3 s-3', conversion=US%s_to_T**3) CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & 'Convert TKE to Kd', 's2 m', & conversion=(US%Z_to_m**2)*(US%T_to_s**2)) From f17d5e63a819c554b2790ce058b3f3deebe6b396 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 8 May 2019 17:36:24 -0400 Subject: [PATCH 040/106] MOM_set_diffusivity: more TKE time scaling --- .../vertical/MOM_set_diffusivity.F90 | 40 ++++++++++--------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 09c070e271..61eb1be5d8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -493,7 +493,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & Kd_lay, Kd_int, dd%Kd_BBL) else call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - US%s_to_T**3 * maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) + maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -1155,7 +1155,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum-realizable thickness [m3 s-3] + !! to its maximum-realizable thickness [m3 T-3 ~> m3 s-3] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure @@ -1179,12 +1179,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! the local ustar, times R0_g [kg m-2] Rho_top, & ! density at top of the BBL [kg m-3] TKE, & ! turbulent kinetic energy available to drive - ! bottom-boundary layer mixing in a layer [m3 s-3] + ! bottom-boundary layer mixing in a layer [m3 T-3 ~> m3 s-3] I2decay ! inverse of twice the TKE decay scale [Z-1 ~> m-1]. - real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 s-3] - real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [m3 s-3] - real :: TKE_here ! TKE that goes into mixing in this layer [m3 s-3] + real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 T-3 ~> m3 s-3] + real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [m3 T-3 ~> m3 s-3] + real :: TKE_here ! TKE that goes into mixing in this layer [m3 T-3 ~> m3 s-3] real :: dRl, dRbot ! temporaries holding density differences [kg m-3] 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]. @@ -1235,10 +1235,10 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * & exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * & - visc%TKE_BBL(i,j) + (US%T_to_s**3 * visc%TKE_BBL(i,j)) if (associated(fluxes%TKE_tidal)) & - TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * & + TKE(i) = TKE(i) + (US%T_to_s**3 * fluxes%TKE_tidal(i,j)) * I_Rho0 * & (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz)))) ! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following @@ -1296,6 +1296,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! TKE_Ray has been initialized to 0 above. if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%Z_to_m * G%IareaT(i,j) * & + US%T_to_s**3 * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1308,13 +1309,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k))) then - delta_Kd = (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k)) - Kd_lay(i,j,k) + if (Kd_lay(i,j,k) < US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k))) then + delta_Kd = US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) - Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_max Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else - Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k)) + Kd_lay(i,j,k) = US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) endif Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd @@ -1324,22 +1325,23 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd_lay(i,j,k) >= maxTKE(i,k)*(US%T_to_s**2 * TKE_to_Kd(i,k))) then + if (Kd_lay(i,j,k) >= US%s_to_T * (maxTKE(i,k) * TKE_to_Kd(i,k))) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*(US%T_to_s**2 * TKE_to_Kd(i,k)) > & - maxTKE(i,k)*(US%T_to_s**2 * TKE_to_Kd(i,k))) then - TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/(US%T_to_s**2 * TKE_to_Kd(i,k)) ) - & - maxTKE(i,k) + elseif (Kd_lay(i,j,k) + US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) > & + US%s_to_T * (maxTKE(i,k) * TKE_to_Kd(i,k))) then + TKE_here = ((TKE_to_layer + TKE_Ray) + (US%T_to_s * Kd_lay(i,j,k)) / TKE_to_Kd(i,k)) & + - maxTKE(i,k) + ! ### Non-bracketed ternary sum TKE(i) = TKE(i) - TKE_here + TKE_Ray else - TKE_here = TKE_to_layer + TKE_ray + TKE_here = TKE_to_layer + TKE_Ray TKE(i) = TKE(i) - TKE_to_Layer endif if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = TKE_here * (US%T_to_s**2 * TKE_to_Kd(i,k)) + delta_Kd = US%s_to_T * (TKE_here * TKE_to_Kd(i,k)) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd @@ -1397,7 +1399,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Local variables real :: TKE_column ! net TKE input into the column [m3 s-3] - real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 s-3] + real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 T-3 ~> m3 s-3] real :: TKE_Ray ! TKE from a layer Rayleigh drag used to drive mixing in that layer [m3 s-3] real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [m3 s-3] real :: TKE_consumed ! TKE used for mixing in this layer [m3 s-3] From f5f3662776b20ae6bd09dc09381565052357b5ca Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 9 May 2019 13:18:19 -0400 Subject: [PATCH 041/106] MOM_set_diffusivity time scaling: more params The following parameters have been time scaled: * Kd_min * Kd_max The following physical constants have been scaled: * kpp_fill * dt_fill Internal variables: * delta_kd Some units in comments have also been fixed --- .../vertical/MOM_set_diffusivity.F90 | 68 ++++++++++--------- 1 file changed, 36 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 61eb1be5d8..153c60a71a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -77,8 +77,8 @@ module MOM_set_diffusivity !! bottom-drag driven turbulence [Z-1 ~> m-1]. real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. real :: Kd !< interior diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: Kd_min !< minimum diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: Kd_max !< maximum increment for diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: Kd_max !< maximum increment for diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without !! filtering or scaling [Z2 s-1 ~> m2 s-1]. @@ -112,7 +112,7 @@ module MOM_set_diffusivity !! where N2 is the squared buoyancy frequency [s-2] and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer [Z2 s-1 ~> m2 s-1]. + !! radiated from the base of the mixed layer [Z2 T-1 ~> m2 s-1]. real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below @@ -270,8 +270,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed - real :: kappa_fill ! diffusivity used to fill massless layers - real :: dt_fill ! timestep used to fill massless layers + real :: kappa_fill ! diffusivity used to fill massless layers [Z2 T-1 ~> m2 s-1] + real :: dt_fill ! timestep used to fill massless layers [T ~> s] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -281,9 +281,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - I_Rho0 = 1.0/GV%Rho0 - kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. - dt_fill = 7200. !### Dimensionalconstant [s]. + I_Rho0 = 1.0 / GV%Rho0 + kappa_fill = 1.e-3 * US%m_to_Z**2 * US%T_to_s + dt_fill = 7200. * US%s_to_T Omega2 = CS%omega * CS%omega use_EOS = associated(tv%eqn_of_state) @@ -336,7 +336,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(tv%S, "before vert_fill_TS tv%S",G%HI) call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m) endif - call vert_fill_TS(h, tv%T, tv%S, kappa_fill, dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, (US%s_to_T)*kappa_fill, & + (US%T_to_s)*dt_fill, T_f, S_f, G, GV) if (CS%debug) then call hchksum(tv%T, "after vert_fill_TS tv%T",G%HI) call hchksum(tv%S, "after vert_fill_TS tv%S",G%HI) @@ -352,7 +353,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call cpu_clock_begin(id_clock_kappaShear) if (CS%Vertex_shear) then call full_convection(G, GV, h, tv, T_adj, S_adj, fluxes%p_surf, & - GV%Z_to_H**2*kappa_fill*dt_fill, halo=1) + (GV%Z_to_H**2)*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) @@ -468,7 +469,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif endif - call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, US%s_to_T * dt, G, GV, US, CS, TKE_to_Kd, & + call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, (US%s_to_T)*dt, G, GV, US, CS, TKE_to_Kd, & maxTKE, kb) if (associated(dd%maxTKE)) then ; do k=1,nz ; do i=is,ie dd%maxTKE(i,j,k) = maxTKE(i,k) @@ -482,8 +483,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - call calculate_tidal_mixing(h, US%s_to_T**2 * N2_bot, j, US%T_to_s**2 * TKE_to_Kd, US%s_to_T**3 * maxTKE, G, GV, US, CS%tm_csp, & - US%s_to_T**2 * N2_lay, US%s_to_T**2 * N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) + call calculate_tidal_mixing(h, (US%s_to_T**2)*N2_bot, j, (US%T_to_s**2)*TKE_to_Kd, (US%s_to_T**3)*maxTKE, G, GV, US, CS%tm_csp, & + (US%s_to_T**2)*N2_lay, (US%s_to_T**2)*N2_int, Kd_lay, Kd_int, (US%s_to_T*CS%Kd_max), visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. @@ -740,7 +741,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * (US%T_to_s * CS%Kd_max) ! Units of m3 T-3. + maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of m3 T-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -1191,7 +1192,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real :: absf ! average absolute Coriolis parameter around a thickness point [T-1 ~> s-1] real :: R0_g ! Rho0 / G_Earth [kg T2 Z-1 m-4 ~> kg s2 m-5] real :: I_rho0 ! 1 / RHO0 [m3 kg-1] - real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 s-1 ~> m2 s-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 ! defined in visc, on the assumption that this ! extracted energy also drives diapycnal mixing. @@ -1221,7 +1222,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = (US%T_to_s * visc%ustar_BBL(i,j)) + ustar_h = US%T_to_s * visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & @@ -1310,18 +1311,18 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer if (Kd_lay(i,j,k) < US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k))) then - delta_Kd = US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) - Kd_lay(i,j,k) + delta_Kd = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) - (US%T_to_s * Kd_lay(i,j,k)) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_max - Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%s_to_T * delta_Kd) else Kd_lay(i,j,k) = US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) endif - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5* (US%s_to_T * 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 + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 *(US%s_to_T * delta_Kd) endif endif else @@ -1341,14 +1342,14 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = US%s_to_T * (TKE_here * TKE_to_Kd(i,k)) + 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,j,k) = Kd_lay(i,j,k) + delta_Kd - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%s_to_T * delta_Kd) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 *(US%s_to_T * 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 + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 *(US%s_to_T * delta_Kd) endif endif endif @@ -1512,7 +1513,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & else ! Either N2=0 or dh = 0. if (TKE_remaining > 0.) then - Kd_wall = CS%Kd_max + Kd_wall = (US%s_to_T * CS%Kd_max) else Kd_wall = 0. endif @@ -1653,7 +1654,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if ((US%s_to_T**3 * TKE_ml_flux(i)) * I_decay(i) < 0.1*CS%Kd_min*US%Z_to_m**3*(US%s_to_T**2 * Omega2)) then + if (TKE_ml_flux(i) * I_decay(i) & + < 0.1 * CS%Kd_min * US%Z_to_m**3 * Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -2089,11 +2091,13 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, & + scale=(US%m_to_Z**2)*(US%T_to_s)) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& - "negative value for no limit.", units="m2 s-1", default=-1.0, scale=US%m_to_Z**2) + "negative value for no limit.", units="m2 s-1", default=-1.0, & + scale=(US%m_to_Z**2)*(US%T_to_s)) if (CS%simple_TKE_to_Kd .and. 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, "KD_ADD", CS%Kd_add, & From 6db963179c0ed6e95b3ed99da4822c4fc0a7c968 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 May 2019 13:49:29 -0400 Subject: [PATCH 042/106] +Added newlines in long parameter descriptions Added newlines in long parameter descriptions in 6 modules. All answers are bitwise identical, but there are changes in comments in the MOM_parameter_doc files. --- src/core/MOM_PressureForce_analytic_FV.F90 | 4 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 4 ++-- src/core/MOM_open_boundary.F90 | 5 +++-- .../lateral/MOM_hor_visc.F90 | 8 +++---- .../vertical/MOM_CVMix_KPP.F90 | 22 +++++++++---------- .../vertical/MOM_diabatic_driver.F90 | 11 +++++----- 6 files changed, 27 insertions(+), 27 deletions(-) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index a8fcae3596..cdbfc40dfc 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -831,8 +831,8 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C "The default is set by USE_REGRIDDING.", & default=use_ALE ) call get_param(param_file, mdl, "PRESSURE_RECONSTRUCTION_SCHEME", CS%Recon_Scheme, & - "Order of vertical reconstruction of T/S to use in the\n"//& - "integrals within the FV pressure gradient calculation."//& + "Order of vertical reconstruction of T/S to use in the \n"//& + "integrals within the FV pressure gradient calculation.\n"//& " 0: PCM or no reconstruction.\n"//& " 1: PLM reconstruction.\n"//& " 2: PPM reconstruction.", default=1) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index a675eebaf4..96af5748b6 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -823,8 +823,8 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, US, param_file, diag, CS, tid "The default is set by USE_REGRIDDING.", & default=use_ALE ) call get_param(param_file, mdl, "PRESSURE_RECONSTRUCTION_SCHEME", CS%Recon_Scheme, & - "Order of vertical reconstruction of T/S to use in the\n"//& - "integrals within the FV pressure gradient calculation."//& + "Order of vertical reconstruction of T/S to use in the \n"//& + "integrals within the FV pressure gradient calculation.\n"//& " 0: PCM or no reconstruction.\n"//& " 1: PLM reconstruction.\n"//& " 2: PPM reconstruction.", default=1) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c59eafc4c2..ed42f6367d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -305,8 +305,9 @@ subroutine open_boundary_config(G, US, param_file, OBC) real :: Lscale_in, Lscale_out ! parameters controlling tracer values at the boundaries allocate(OBC) - call log_version(param_file, mdl, version, "Controls where open boundaries are located, what "//& - "kind of boundary condition to impose, and what data to apply, if any.") + call log_version(param_file, mdl, version, & + "Controls where open boundaries are located, what kind of boundary condition \n"//& + "to impose, and what data to apply, if any.") call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & "The number of open boundary segments.", & default=0) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2c4bb99ae9..f6baf11db3 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1217,19 +1217,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "the biharmonic viscosity.", default=.false.) 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 \n"//& - "viscosities. The final viscosity is the maximum of the other "//& + "If true, read a file containing 2-d background harmonic \n"//& + "viscosities. The final viscosity is the maximum of the other \n"//& "terms and this background value.", default=.false.) if (CS%bound_Kh .or. CS%bound_Ah .or. CS%better_bound_Kh .or. CS%better_bound_Ah) & call get_param(param_file, mdl, "DT", dt, & - "The (baroclinic) dynamics time step.", units = "s", & + "The (baroclinic) dynamics time step.", units="s", & fail_if_missing=.true.) if (CS%no_slip .and. CS%biharmonic) & call MOM_error(FATAL,"ERROR: NOSLIP and BIHARMONIC cannot be defined "// & - "at the same time in MOM.") + "at the same time in MOM.") if (.not.(CS%Laplacian .or. CS%biharmonic)) then ! Only issue inviscid warning if not in single column mode (usually 2x2 domain) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 139754cada..68d7085b30 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -328,19 +328,19 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) '\t ParabolicNonLocal = sigma*(1-sigma)^2 for diffusivity; (1-sigma)^2 for NLT', & default='SimpleShapes') if (CS%MatchTechnique == 'ParabolicNonLocal') then - ! This forces Cs2 (Cs in non-local computation) to equal 1 for parabolic non-local option. - ! May be used during CVMix initialization. - Cs_is_one=.true. + ! This forces Cs2 (Cs in non-local computation) to equal 1 for parabolic non-local option. + ! May be used during CVMix initialization. + Cs_is_one=.true. endif if (CS%MatchTechnique == 'ParabolicNonLocal' .or. CS%MatchTechnique == 'SimpleShapes') then - ! if gradient won't be matched, lnoDGat1=.true. - lnoDGat1=.true. + ! if gradient won't be matched, lnoDGat1=.true. + lnoDGat1=.true. endif ! safety check to avoid negative diff/visc if (CS%MatchTechnique == 'MatchBoth' .and. (CS%interpType2 == 'cubic' .or. & - CS%interpType2 == 'quadratic')) then - call MOM_error(FATAL,"If MATCH_TECHNIQUE=MatchBoth, INTERP_TYPE2 must be set to \n"//& + CS%interpType2 == 'quadratic')) then + call MOM_error(FATAL,"If MATCH_TECHNIQUE=MatchBoth, INTERP_TYPE2 must be set to \n"//& "linear or LMD94 (recommended) to avoid negative viscosity and diffusivity.\n"//& "Please select one of these valid options." ) endif @@ -349,15 +349,15 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'If True, zeroes the KPP diffusivity and viscosity; for testing purpose.',& default=.False.) call get_param(paramFile, mdl, 'KPP_IS_ADDITIVE', CS%KPPisAdditive, & - 'If true, adds KPP diffusivity to diffusivity from other schemes.'//& + 'If true, adds KPP diffusivity to diffusivity from other schemes.\n'//& 'If false, KPP is the only diffusivity wherever KPP is non-zero.', & default=.True.) call get_param(paramFile, mdl, 'KPP_SHORTWAVE_METHOD',string, & - 'Determines contribution of shortwave radiation to KPP surface '// & + 'Determines contribution of shortwave radiation to KPP surface \n'// & 'buoyancy flux. Options include:\n'// & ' ALL_SW: use total shortwave radiation\n'// & - ' MXL_SW: use shortwave radiation absorbed by mixing layer\n'// & - ' LV1_SW: use shortwave radiation absorbed by top model layer', & + ' MXL_SW: use shortwave radiation absorbed by mixing layer\n'// & + ' LV1_SW: use shortwave radiation absorbed by top model layer', & default='MXL_SW') select case ( trim(string) ) case ("ALL_SW") ; CS%SW_METHOD = SW_METHOD_ALL_SW diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b5141c2515..681bf33b2b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2911,12 +2911,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di default=.true.) call get_param(param_file, mdl, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & - "If true, the net incoming and outgoing fresh water fluxes are combined\n"//& - "and applied as either incoming or outgoing depending on the sign of the net.\n"//& - "If false, the net incoming fresh water flux is added to the model and\n"//& - "thereafter the net outgoing is removed from the updated state."//& - "into the first non-vanished layer for which the column remains stable", & - default=.true.) + "If true, the net incoming and outgoing fresh water fluxes are combined \n"//& + "and applied as either incoming or outgoing depending on the sign of the net. \n"//& + "If false, the net incoming fresh water flux is added to the model and \n"//& + "thereafter the net outgoing is removed from the topmost non-vanished \n"//& + "layers of the updated state.", default=.true.) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & From 6d0c938ab7f4e89bec37bf45ff5ef9116fa3fb37 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 May 2019 13:51:35 -0400 Subject: [PATCH 043/106] +Revised writeMessageAndDesc to split long lines Revised writeMessageAndDesc to split comment lines that are longer than 112 characters long (usually this is a 32 character indent, with an 80 character description block), including aligned indents of continuing lines in indented lists. This will change some MOM_parameter doc files with very long lines, and it will eliminate the need for explicit newlines in get_param, log_param, and log_version calls, although they still work as before in shorter lines. All answers are bitwise identical, but a line or two in some MOM_parameter_doc files and some SIS_parameter_doc files change. --- src/framework/MOM_document.F90 | 85 +++++++++++++++++++++++----------- 1 file changed, 58 insertions(+), 27 deletions(-) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index 36f43528be..75496544db 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -40,6 +40,7 @@ module MOM_document logical :: defineSyntax = .false. !< If true, use '\#def' syntax instead of a=b syntax logical :: warnOnConflicts = .false. !< Cause a WARNING error if defaults differ. integer :: commentColumn = 32 !< Number of spaces before the comment marker. + integer :: max_line_len = 112 !< The maximum length of message lines. type(link_msg), pointer :: chain_msg => NULL() !< Database of messages character(len=240) :: blockPrefix = '' !< The full name of the current block. end type doc_type @@ -457,9 +458,16 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & integer, optional, intent(in) :: indent !< An amount by which to indent this message logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. - character(len=mLen) :: mesg - integer :: start_ind = 1, end_ind, indnt, tab, len_tab, len_nl - logical :: all, short, layout, debug + + ! Local variables + character(len=mLen) :: mesg ! A full line of a message including indents. + character(len=mLen) :: mesg_text ! A line of message text without preliminary indents. + integer :: start_ind = 1 ! The starting index in the description for the next line. + integer :: nl_ind, tab_ind, end_ind ! The indices of new-lines, tabs, and the end of a line. + integer :: len_text, len_tab, len_nl ! The lengths of the text string, tabs and new-lines. + integer :: indnt, msg_pad ! Space counts used to format a message. + logical :: msg_done, reset_msg_pad ! Logicals used to format messages. + logical :: all, short, layout, debug ! Flags indicating which files to write into. layout = .false. ; if (present(layoutParam)) layout = layoutParam debug = .false. ; if (present(debuggingParam)) debug = debuggingParam @@ -475,41 +483,64 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & if (len_trim(desc) == 0) return len_tab = len_trim("_\t_") - 2 - len_nl = len_trim("_\n_") -2 + len_nl = len_trim("_\n_") - 2 indnt = doc%commentColumn ; if (present(indent)) indnt = indent - start_ind = 1 + len_text = doc%max_line_len - (indnt + 2) + start_ind = 1 ; msg_pad = 0 ; msg_done = .false. do if (len_trim(desc(start_ind:)) < 1) exit - end_ind = index(desc(start_ind:), "\n") + nl_ind = index(desc(start_ind:), "\n") - if (end_ind > 0) then - mesg = repeat(" ",indnt)//"! "//trim(desc(start_ind:start_ind+end_ind-2)) - start_ind = start_ind + end_ind - 1 + len_nl + end_ind = 0 + if ((nl_ind > 0) .and. (len_trim(desc(start_ind:start_ind+nl_ind-2)) > len_text-msg_pad)) then + ! This line is too long despite the new-line character. Look for an earlier space to break. + end_ind = scan(desc(start_ind:start_ind+(len_text-msg_pad)), " ", back=.true.) - 1 + if (end_ind > 0) nl_ind = 0 + elseif ((nl_ind == 0) .and. (len_trim(desc(start_ind:)) > len_text-msg_pad)) then + ! This line is too long and does not have a new-line character. Look for a space to break. + end_ind = scan(desc(start_ind:start_ind+(len_text-msg_pad)), " ", back=.true.) - 1 + endif - do ; tab = index(mesg, "\t") - if (tab == 0) exit - mesg(tab:) = " "//trim(mesg(tab+len_tab:)) - enddo - if (all) write(doc%unitAll, '(a)') trim(mesg) - if (short) write(doc%unitShort, '(a)') trim(mesg) - if (layout) write(doc%unitLayout, '(a)') trim(mesg) - if (debug) write(doc%unitDebugging, '(a)') trim(mesg) + reset_msg_pad = .false. + if (nl_ind > 0) then + mesg_text = trim(desc(start_ind:start_ind+nl_ind-2)) + start_ind = start_ind + nl_ind + len_nl - 1 + reset_msg_pad = .true. + elseif (end_ind > 0) then + mesg_text = trim(desc(start_ind:start_ind+end_ind)) + start_ind = start_ind + end_ind + 1 + ! Adjust the starting point to move past leading spaces. + start_ind = start_ind + (len_trim(desc(start_ind:)) - len_trim(adjustl(desc(start_ind:)))) else - mesg = repeat(" ",indnt)//"! "//trim(desc(start_ind:)) - do ; tab = index(mesg, "\t") - if (tab == 0) exit - mesg(tab:) = " "//trim(mesg(tab+len_tab:)) - enddo - if (all) write(doc%unitAll, '(a)') trim(mesg) - if (short) write(doc%unitShort, '(a)') trim(mesg) - if (layout) write(doc%unitLayout, '(a)') trim(mesg) - if (debug) write(doc%unitDebugging, '(a)') trim(mesg) - exit + mesg_text = trim(desc(start_ind:)) + msg_done = .true. endif + do ; tab_ind = index(mesg_text, "\t") ! Replace \t with 2 spaces. + if (tab_ind == 0) exit + mesg_text(tab_ind:) = " "//trim(mesg_text(tab_ind+len_tab:)) + enddo + + mesg = repeat(" ",indnt)//"! "//repeat(" ",msg_pad)//trim(mesg_text) + + if (reset_msg_pad) then + msg_pad = 0 + elseif (msg_pad == 0) then ! Indent continuation lines. + msg_pad = len_trim(mesg_text) - len_trim(adjustl(mesg_text)) + ! If already indented, indent an additional 2 spaces. + if (msg_pad >= 2) msg_pad = msg_pad + 2 + endif + + if (all) write(doc%unitAll, '(a)') trim(mesg) + if (short) write(doc%unitShort, '(a)') trim(mesg) + if (layout) write(doc%unitLayout, '(a)') trim(mesg) + if (debug) write(doc%unitDebugging, '(a)') trim(mesg) + + if (msg_done) exit enddo + end subroutine writeMessageAndDesc ! ---------------------------------------------------------------------- From 5a59262b5a017aeb9b7a9b867d08adc433beaebd Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 9 May 2019 13:53:39 -0400 Subject: [PATCH 044/106] * Bugfix: Double diffusive correction to Kd The double-diffusive salinity correction to diffusivity was incorrectly using an exponent in its term: Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5**KS_extra(i,K) The exponent has been replaced with a multiplication. --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 962a9d07c2..171b88e23b 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -417,8 +417,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5**KS_extra(i,K) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5**KS_extra(i,K) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KS_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*KS_extra(i,K) visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. From d19bd6123fb20811cb2c37fdf77b2430c8b1b483 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 10 May 2019 13:57:16 -0400 Subject: [PATCH 045/106] MOM_set_diffusivity LOTW time scaling Mostly rescaling of internal variables for LOTW diffusivity. --- .../vertical/MOM_set_diffusivity.F90 | 53 +++++++++---------- 1 file changed, 26 insertions(+), 27 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 153c60a71a..5cf4c4305f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1399,24 +1399,23 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1] ! Local variables - real :: TKE_column ! net TKE input into the column [m3 s-3] + real :: TKE_column ! net TKE input into the column [m3 T-3 ~> m3 s-3] real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 T-3 ~> m3 s-3] - real :: TKE_Ray ! TKE from a layer Rayleigh drag used to drive mixing in that layer [m3 s-3] - real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [m3 s-3] - real :: TKE_consumed ! TKE used for mixing in this layer [m3 s-3] - real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [m3 s-3] + real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [m3 T-3 ~> m3 s-3] + real :: TKE_consumed ! TKE used for mixing in this layer [m3 T-3 ~> m3 s-3] + real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [m3 T-3 ~> m3 s-3] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] - real :: ustar ! value of ustar at a thickness point [Z s-1 ~> m s-1]. - real :: ustar2 ! square of ustar, for convenience [Z2 s-2 ~> m2 s-2] - real :: absf ! average absolute value of Coriolis parameter around a thickness point [s-1] + real :: ustar ! value of ustar at a thickness point [Z T-1 ~> m s-1]. + real :: ustar2 ! square of ustar, for convenience [Z2 T-2 ~> m2 s-2] + real :: absf ! average absolute value of Coriolis parameter around a thickness point [T-1 ~> s-1] real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely [Z ~> m]. real :: z_bot ! distance to interface k from bottom [Z ~> m]. real :: D_minus_z ! distance to interface k from surface [Z ~> m]. real :: total_thickness ! total thickness of water column [Z ~> m]. real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height [Z-1 ~> m-1]. - real :: Kd_wall ! Law of the wall diffusivity [Z2 s-1 ~> m2 s-1]. - real :: Kd_lower ! diffusivity for lower interface [Z2 s-1 ~> m2 s-1] - real :: ustar_D ! u* x D [Z2 s-1 ~> m2 s-1]. + 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 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 @@ -1437,32 +1436,31 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & I_Rho0 = 1.0/GV%Rho0 cdrag_sqrt = sqrt(CS%cdrag) - TKE_Ray = 0. ! In case Rayleigh_drag is not used. do i=G%isc,G%iec ! Developed in single-column mode ! Column-wise parameters. - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! + absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom [m s-1]. - ustar = visc%ustar_BBL(i,j) + ustar = US%T_to_s * visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (associated(fluxes%ustar_tidal)) ustar = ustar + US%m_to_Z*fluxes%ustar_tidal(i,j) + if (associated(fluxes%ustar_tidal)) ustar = ustar + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. Idecay = CS%IMax_decay - if ((ustar > 0.0) .and. (absf > CS%IMax_decay*ustar)) Idecay = absf / ustar + if ((ustar > 0.0) .and. (absf > CS%IMax_decay * ustar)) Idecay = absf / ustar ! Energy input at the bottom [m3 s-3]. ! (Note that visc%TKE_BBL is in 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) + TKE_column = cdrag_sqrt * (US%T_to_s**3 * visc%TKE_BBL(i,j)) ! Add in tidal dissipation energy at the bottom [m3 s-3]. ! Note that TKE_tidal is in [W m-2]. - if (associated(fluxes%TKE_tidal)) TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 + if (associated(fluxes%TKE_tidal)) TKE_column = TKE_column + (US%T_to_s**3 * fluxes%TKE_tidal(i,j)) * I_Rho0 TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column @@ -1480,6 +1478,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & + US%T_to_s**3 * & 0.5*CS%BBL_effic * US%Z_to_m * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & @@ -1498,22 +1497,22 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. else - Kd_wall = ( ( von_karm * ustar2 ) * ( z_bot * D_minus_z ) ) / & - ( ustar_D + absf * ( z_bot * D_minus_z ) ) + Kd_wall = ((von_karm * ustar2) * (z_bot * D_minus_z)) & + / (ustar_D + absf * (z_bot * D_minus_z)) endif ! TKE associated with Kd_wall [m3 s-2]. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = US%Z_to_m**3 * US%s_to_T**2 * Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = US%Z_to_m**3 * Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall > 0.) then TKE_consumed = min(TKE_Kd_wall, TKE_remaining) - Kd_wall = (TKE_consumed/TKE_Kd_wall) * Kd_wall ! Scale Kd so that only TKE_consumed is used. + Kd_wall = (TKE_consumed / TKE_Kd_wall) * Kd_wall ! Scale Kd so that only TKE_consumed is used. else ! Either N2=0 or dh = 0. if (TKE_remaining > 0.) then - Kd_wall = (US%s_to_T * CS%Kd_max) + Kd_wall = CS%Kd_max else Kd_wall = 0. endif @@ -1524,10 +1523,10 @@ 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. - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(Kd_wall + Kd_lower) + Kd_int(i,j,K) = Kd_int(i,j,K) + (US%s_to_T * Kd_wall) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * ((US%s_to_T * Kd_wall) + (US%s_to_T * Kd_lower)) Kd_lower = Kd_wall ! Store for next level up. - if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall + if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = (US%s_to_T * Kd_wall) enddo ! k enddo ! i From 368db7af8c95c64538e7e7db9cb56b0ee10dc9ff Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 10 May 2019 16:24:02 -0400 Subject: [PATCH 046/106] MOM_set_diffusivity time scaling: DD, bg diff, zint The double diffusive calculations were time-scaled, as well as the diagnostics. Background diffusivities and viscosities were also time-scaled, although a few could not be tested due to lack of experiments depending on the output. Two unused double-diffusive parameters were re-enabled and integrated into the source, replacing fixed dimensional constants: * MAX_SALT_DIFF_SALT_FINGERS * KV_MOLECULAR The legacy "zint" diagnostic scaling was implemented, but it is untested since few experiments still use these tests. --- .../vertical/MOM_set_diffusivity.F90 | 93 ++++++++++--------- 1 file changed, 50 insertions(+), 43 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 94c5eac171..3c3089282a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -75,14 +75,14 @@ module MOM_set_diffusivity real :: cdrag !< quadratic drag coefficient [nondim] real :: IMax_decay !< inverse of a maximum decay scale for !! bottom-drag driven turbulence [Z-1 ~> m-1]. - real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. - real :: Kd !< interior diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. + real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real :: Kd_max !< maximum increment for diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling [Z2 s-1 ~> m2 s-1]. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + !! filtering or scaling [Z2 T-1 ~> m2 s-1]. + real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness [meter] when BULKMIXEDLAYER==.false. type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing @@ -144,8 +144,8 @@ module MOM_set_diffusivity logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that !! does not rely on a layer-formulation. real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering - real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 s-1 ~> m2 s-1] - real :: Kv_molecular !< molecular visc for double diff convect [Z2 s-1 ~> m2 s-1] + real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] + real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module @@ -295,9 +295,9 @@ 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. ! If nothing else is specified, this will be the value used. - Kd_lay(:,:,:) = CS%Kd - Kd_int(:,:,:) = CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv + Kd_lay(:,:,:) = US%s_to_T * CS%Kd + Kd_int(:,:,:) = US%s_to_T * CS%Kd + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = US%s_to_T * CS%Kv ! Set up arrays for diagnostics. @@ -413,14 +413,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KT_extra(i,K) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * (US%s_to_T * KT_extra(i,K)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (US%s_to_T * KT_extra(i,K)) + visc%Kd_extra_S(i,j,k) = US%s_to_T * (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KS_extra(i,K) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * (US%s_to_T * KS_extra(i,K)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (US%s_to_T * KS_extra(i,K)) + visc%Kd_extra_T(i,j,k) = US%s_to_T * (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -559,13 +559,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (present(Kd_int)) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add - Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + US%s_to_T * CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + US%s_to_T * CS%Kd_add enddo ; enddo ; enddo else !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + US%s_to_T * CS%Kd_add enddo ; enddo ; enddo endif endif @@ -1062,10 +1062,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp [Z2 s-1 ~> m2 s-1]. + !! diffusivity for temp [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln [Z2 s-1 ~> m2 s-1]. + !! diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density wrt temp [kg m-3 degC-1] @@ -1079,20 +1079,15 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real :: Rrho ! vertical density ratio [nondim] real :: diff_dd ! factor for double-diffusion [nondim] - real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 s-1 ~> m2 s-1] + real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 T-1 ~> m2 s-1] real :: prandtl ! flux ratio for diffusive convection regime real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio [nondim] - real :: dsfmax ! max diffusivity in case of salt fingering [Z2 s-1 ~> m2 s-1] - real :: Kv_molecular ! molecular viscosity [Z2 s-1 ~> m2 s-1] integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke if (associated(tv%eqn_of_state)) then - dsfmax = US%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to [Z2 s-1 ~> m2 s-1] - Kv_molecular = US%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to [Z2 s-1 ~> m2 s-1] - do i=is,ie pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 @@ -1113,16 +1108,16 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case Rrho = min(alpha_dT / beta_dS, Rrho0) diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) - Kd_dd = dsfmax * diff_dd*diff_dd*diff_dd - Kd_T_dd(i,K) = 0.7*Kd_dd + Kd_dd = CS%Max_salt_diff_salt_fingers * diff_dd*diff_dd*diff_dd + Kd_T_dd(i,K) = 0.7 * Kd_dd Kd_S_dd(i,K) = Kd_dd elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection Rrho = alpha_dT / beta_dS - Kd_dd = Kv_molecular * 0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) + Kd_dd = CS%Kv_molecular * 0.909 * exp(4.6 * exp(-0.54 * (1/Rrho - 1))) prandtl = 0.15*Rrho if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho Kd_T_dd(i,K) = Kd_dd - Kd_S_dd(i,K) = prandtl*Kd_dd + Kd_S_dd(i,K) = prandtl * Kd_dd else Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 endif @@ -2082,12 +2077,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) + units="m2 s-1", scale=(US%m_to_Z**2)*US%T_to_s, & + fail_if_missing=.true.) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=(US%m_to_Z**2)*US%T_to_s, & + fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, & @@ -2102,7 +2099,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added \n"//& "everywhere without any filtering or scaling.", & - units="m2 s-1", default=0.0, scale=US%m_to_Z**2) + units="m2 s-1", default=0.0, scale=(US%m_to_Z**2)*US%T_to_s) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") @@ -2116,11 +2113,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%Kdml = CS%Kd ! This is not used with a bulk mixed layer, but also ! cannot be a NaN. else + ! ### This parameter is unused and is staged for deletion call get_param(param_file, mdl, "KDML", CS%Kdml, & "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", & + default=CS%Kd*(US%Z_to_m**2)*US%s_to_T, & + scale=(US%m_to_Z**2)*US%T_to_s) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -2186,9 +2186,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z if (associated(diag_to_Z_CSp)) then vd = var_desc("N2", "s-2", & "Buoyancy frequency, interpolated to z", z_grid='z') - CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%s_to_T**2) if (CS%user_change_diff) & - CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) + CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & + conversion=(US%Z_to_m**2)*US%s_to_T) endif endif @@ -2203,30 +2204,36 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z default=2.55, units="nondim") call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & "Maximum salt diffusivity for salt fingering regime.", & - default=1.e-4, units="m2 s-1") + default=1.e-4, units="m2 s-1", scale=(US%m_to_Z**2)*US%T_to_s) call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & "Molecular viscosity for calculation of fluxes under \n"//& - "double-diffusive convection.", default=1.5e-6, units="m2 s-1") + "double-diffusive convection.", default=1.5e-6, units="m2 s-1", & + scale=(US%m_to_Z**2)*US%T_to_s) ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. CS%id_KT_extra = register_diag_field('ocean_model', 'KT_extra', diag%axesTi, Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z_to_m**2) + 'Double-diffusive diffusivity for temperature', 'm2 s-1', & + conversion=(US%Z_to_m**2)*US%s_to_T) CS%id_KS_extra = register_diag_field('ocean_model', 'KS_extra', diag%axesTi, Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Double-diffusive diffusivity for salinity', 'm2 s-1', & + conversion=(US%Z_to_m**2)*US%s_to_T) if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) + CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & + conversion=(US%Z_to_m**2)*US%s_to_T) vd = var_desc("KS_extra", "m2 s-1", & "Double-Diffusive Salinity Diffusivity, interpolated to z", & z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) + CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & + conversion=(US%Z_to_m**2)*US%s_to_T) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) + CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & + conversion=(US%Z_to_m**2)*US%s_to_T) endif endif ! old double-diffusion From 9a9f3d0b2ff092e065d4b582e20b9111339d0e9a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 11 May 2019 09:46:53 -0400 Subject: [PATCH 047/106] MOM_set_diffusivity time scaling: subroutines Some de-scaling of variables passed to other subroutines has been shifted out of MOM_set_diffusivity.F90 and into the subroutine source files. --- .../lateral/MOM_thickness_diffuse.F90 | 4 ++-- .../vertical/MOM_bkgnd_mixing.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 11 ++++++----- .../vertical/MOM_tidal_mixing.F90 | 18 +++++++++--------- 4 files changed, 19 insertions(+), 18 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 802e26a404..b549c7a6ef 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1621,8 +1621,8 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] - real, intent(in) :: kappa !< Constant diffusivity to use [Z2 s-1 ~> m2 s-1] - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: kappa !< Constant diffusivity to use [Z2 T-1 ~> m2 s-1] + real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] integer, optional, intent(in) :: halo_here !< Number of halo points to work on, diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 12ee411831..d1b3f8faa4 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -388,7 +388,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated - !! with layers [s-2] + !! with layers [T-2 ~> s-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer !! [Z2 s-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface @@ -514,7 +514,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. do k=1,nz ; do i=is,ie abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) + N_2Omega = max(abs_sin,sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 3c3089282a..a9597e9a77 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -282,6 +282,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & "Module must be initialized before it is used.") I_Rho0 = 1.0 / GV%Rho0 + ! ### Dimensional parameters kappa_fill = 1.e-3 * US%m_to_Z**2 * US%T_to_s dt_fill = 7200. * US%s_to_T Omega2 = CS%omega * CS%omega @@ -336,8 +337,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(tv%S, "before vert_fill_TS tv%S",G%HI) call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m) endif - call vert_fill_TS(h, tv%T, tv%S, (US%s_to_T)*kappa_fill, & - (US%T_to_s)*dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, kappa_fill, & + dt_fill, T_f, S_f, G, GV) if (CS%debug) then call hchksum(tv%T, "after vert_fill_TS tv%T",G%HI) call hchksum(tv%S, "after vert_fill_TS tv%S",G%HI) @@ -406,7 +407,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! Add background mixing - call calculate_bkgnd_mixing(h, tv, US%s_to_T**2 * N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, US, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, US, CS%bkgnd_mixing_csp) ! Double-diffusion (old method) if (CS%double_diffusion) then @@ -483,8 +484,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - call calculate_tidal_mixing(h, (US%s_to_T**2)*N2_bot, j, (US%T_to_s**2)*TKE_to_Kd, (US%s_to_T**3)*maxTKE, G, GV, US, CS%tm_csp, & - (US%s_to_T**2)*N2_lay, (US%s_to_T**2)*N2_int, Kd_lay, Kd_int, (US%s_to_T*CS%Kd_max), visc%Kv_slow) + call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tm_csp, & + N2_lay, N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 6f85bc5dbe..f1469ee284 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -659,19 +659,19 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy - !! frequency [s-2]. + !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the - !! layers [s-2]. + !! layers [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the - !! interfaces [s-2]. + !! interfaces [T-2 ~> s-2]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] + !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [m3 s-3] + !! to its maximum realizable thickness [m3 T-3 ~> m3 s-3] type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. @@ -680,17 +680,17 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! [Z2 s-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, - !! [Z2 s-1 ~> m2 s-1]. + !! [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 s-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, Kv) + call calculate_CVMix_tidal(h, j, G, GV, US, CS, (US%s_to_T**2)*N2_int, Kd_lay, Kv) 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, (US%s_to_T**2)*N2_bot, j, (US%T_to_s**2)*TKE_to_Kd, (US%s_to_T**3)*max_TKE, & + G, GV, US, CS, (US%s_to_T**2)*N2_lay, Kd_lay, Kd_int, US%s_to_T*Kd_max) endif endif end subroutine calculate_tidal_mixing From 7862de96b055a0149c992be01fd1594ebee32b98 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 13 May 2019 08:31:07 -0400 Subject: [PATCH 048/106] MOM_set_diffusivity time scaling: Kd_lay --- .../vertical/MOM_bkgnd_mixing.F90 | 14 ++-- .../vertical/MOM_diabatic_driver.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 70 ++++++++++--------- .../vertical/MOM_tidal_mixing.F90 | 14 ++-- 4 files changed, 52 insertions(+), 50 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index d1b3f8faa4..d5ba075d1f 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -390,7 +390,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers [T-2 ~> s-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 s-1 ~> m2 s-1] integer, intent(in) :: j !< Meridional grid index @@ -447,7 +447,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) CS%Kd_bkgnd(i,j,K) = US%m_to_Z**2*Kd_col(K) enddo do k=1,nz - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*US%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m_to_Z**2 * US%T_to_s * (Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop @@ -460,7 +460,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + Kd_lay(i,j,k) = US%T_to_s * ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif @@ -506,7 +506,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) CS%kv_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) * CS%prandtl_bkgnd ! Update Kd (uniform profile; no interpolation needed) - kd_lay(i,j,:) = CS%kd_bkgnd(i,j,1) + kd_lay(i,j,:) = US%T_to_s * CS%kd_bkgnd(i,j,1) enddo @@ -516,13 +516,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = US%T_to_s * max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = US%T_to_s * CS%Kd_sfc(i,j) enddo ; enddo endif @@ -532,7 +532,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) + CS%Kd_bkgnd(i,j,k) = US%s_to_T * (0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K))) CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 24a529716d..e0a9052907 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -298,7 +298,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! one time step [H ~> m or kg m-2] eb_t, & ! amount of fluid entrained from the layer below within ! one time step [H ~> m or kg m-2] - Kd_lay, & ! diapycnal diffusivity of layers [Z2 s-1 ~> m2 s-1] + Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] ! hold, & ! layer thickness before diapycnal entrainment, and later @@ -1677,7 +1677,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=Kd_lay, Kd_int=Kd_int) + ea, eb, kb, Kd_Lay=US%s_to_T*Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a9597e9a77..60d577598a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -225,7 +225,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, intent(in) :: dt !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 s-1 ~> m2 s-1]. + intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 s-1 ~> m2 s-1]. @@ -296,8 +296,8 @@ 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. ! If nothing else is specified, this will be the value used. - Kd_lay(:,:,:) = US%s_to_T * CS%Kd - Kd_int(:,:,:) = US%s_to_T * CS%Kd + Kd_lay(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = US%s_to_T * CS%Kv ! Set up arrays for diagnostics. @@ -414,13 +414,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * (US%s_to_T * KT_extra(i,K)) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (US%s_to_T * KT_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KT_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KT_extra(i,K) visc%Kd_extra_S(i,j,k) = US%s_to_T * (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * (US%s_to_T * KS_extra(i,K)) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (US%s_to_T * KS_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KS_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KS_extra(i,K) visc%Kd_extra_T(i,j,k) = US%s_to_T * (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. @@ -449,7 +449,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5 * US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. @@ -457,15 +457,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & enddo endif do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%T_to_s * (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(i,j,1) = Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 + Kd_int(i,j,1) = US%s_to_T * Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 enddo do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = 0.5 * US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo endif endif @@ -510,7 +510,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k)) ! Floor of Kd_min*rho0/F_Ri Kd_lay(i,j,k) = max(Kd_lay(i,j,k) , & ! Apply floor to Kd - US%s_to_T * dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2)))) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2)))) enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie @@ -524,14 +524,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * (US%Z_to_m**3 * US%T_to_s * Kd_lay(i,j,k)) * N2_lay(i,k) * & + dd%Kd_Work(i,j,k) = GV%Rho0 * (US%Z_to_m**3 * Kd_lay(i,j,k)) * N2_lay(i,k) * & GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3 enddo ; enddo endif enddo ! j-loop if (CS%debug) then - call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & + scale=(US%Z_to_m**2)*US%s_to_T) if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z_to_m**2) @@ -561,12 +562,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = Kd_int(i,j,K) + US%s_to_T * CS%Kd_add - Kd_lay(i,j,k) = Kd_lay(i,j,k) + US%s_to_T * CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + US%s_to_T * CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo endif endif @@ -1158,7 +1159,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),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, !! [Z2 s-1 ~> m2 s-1]. @@ -1306,13 +1307,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd_lay(i,j,k) < US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k))) then - delta_Kd = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) - (US%T_to_s * Kd_lay(i,j,k)) + if (Kd_lay(i,j,k) < (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) then + delta_Kd = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) - Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_max - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%s_to_T * delta_Kd) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else - Kd_lay(i,j,k) = US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) + Kd_lay(i,j,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) endif Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5* (US%s_to_T * delta_Kd) @@ -1322,12 +1323,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd_lay(i,j,k) >= US%s_to_T * (maxTKE(i,k) * TKE_to_Kd(i,k))) then + if (Kd_lay(i,j,k) >= maxTKE(i,k) * TKE_to_Kd(i,k)) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd_lay(i,j,k) + US%s_to_T * ((TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)) > & - US%s_to_T * (maxTKE(i,k) * TKE_to_Kd(i,k))) then - TKE_here = ((TKE_to_layer + TKE_Ray) + (US%T_to_s * Kd_lay(i,j,k)) / TKE_to_Kd(i,k)) & + elseif (Kd_lay(i,j,k) + (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) > & + maxTKE(i,k) * TKE_to_Kd(i,k)) then + TKE_here = ((TKE_to_layer + TKE_Ray) + Kd_lay(i,j,k) / TKE_to_Kd(i,k)) & - maxTKE(i,k) ! ### Non-bracketed ternary sum TKE(i) = TKE(i) - TKE_here + TKE_Ray @@ -1340,12 +1341,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE_here > 0.0) then 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,j,k) = Kd_lay(i,j,k) + (US%s_to_T * delta_Kd) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 *(US%s_to_T * delta_Kd) + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%s_to_T * delta_Kd) if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 *(US%s_to_T * delta_Kd) + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * (US%s_to_T * delta_Kd) endif endif endif @@ -1389,7 +1390,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [T-2 ~> s-2] type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 s-1 ~> m2 s-1] + intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< Interface net diffusivity [Z2 s-1 ~> m2 s-1] real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1] @@ -1520,7 +1521,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add this BBL diffusivity to the model net diffusivity. Kd_int(i,j,K) = Kd_int(i,j,K) + (US%s_to_T * Kd_wall) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * ((US%s_to_T * Kd_wall) + (US%s_to_T * Kd_lower)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = (US%s_to_T * Kd_wall) enddo ! k @@ -1538,7 +1539,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1619,7 +1620,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, endif ; enddo do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%s_to_T * Kd_mlr_ml(i)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr_ml(i) endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then @@ -1642,7 +1643,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, * US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%s_to_T * Kd_mlr) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * Kd_mlr) Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%s_to_T * Kd_mlr) @@ -2161,7 +2162,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & - 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=US%Z_to_m**2) + 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', & + conversion=(US%Z_to_m**2)*(US%s_to_T)) if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index f1469ee284..664860c6b1 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -674,7 +674,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! to its maximum realizable thickness [m3 T-3 ~> m3 s-3] type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, !! [Z2 s-1 ~> m2 s-1]. @@ -709,7 +709,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 s-1 ~> m2 s-1]. + intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 s-1 ~> m2 s-1]. ! Local variables @@ -781,7 +781,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*US%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m_to_Z**2 * US%T_to_s * (Kd_tidal(k) + Kd_tidal(k+1)) enddo ! Update viscosity with the proper unit conversion. @@ -879,7 +879,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*US%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m_to_Z**2 * US%T_to_s * (Kd_tidal(k) + Kd_tidal(k+1)) enddo ! Update viscosity @@ -944,7 +944,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! to its maximum realizable thickness [m3 s-3] type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces !! [Z2 s-1 ~> m2 s-1]. @@ -1192,7 +1192,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s) * Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add @@ -1279,7 +1279,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s) * Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add From 76a6931cf57cfa8c31e09fb5a71aea5b895d3a31 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 13 May 2019 10:19:28 -0400 Subject: [PATCH 049/106] MOM_set_diffusivity time scaling: Kd_int --- .../vertical/MOM_diabatic_driver.F90 | 45 ++++++++++--------- .../vertical/MOM_set_diffusivity.F90 | 40 ++++++++--------- .../vertical/MOM_tidal_mixing.F90 | 12 ++--- 3 files changed, 51 insertions(+), 46 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e0a9052907..578c6a2a61 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -329,7 +329,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & - Kd_int, & ! diapycnal diffusivity of interfaces [Z2 s-1 ~> m2 s-1] + Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] @@ -576,8 +576,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,K) - Kd_heat(i,j,k) = Kd_int(i,j,K) + Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then @@ -1182,7 +1182,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! one time step [H ~> m or kg m-2] eb, & ! amount of fluid entrained from the layer below within ! one time step [H ~> m or kg m-2] - Kd_lay, & ! diapycnal diffusivity of layers [Z2 s-1 ~> m2 s-1] + Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] hold, & ! layer thickness before diapycnal entrainment, and later @@ -1215,7 +1215,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! near the boundaries [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & - Kd_int, & ! diapycnal diffusivity of interfaces [Z2 s-1 ~> m2 s-1] + Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] @@ -1510,8 +1510,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, & + scale=(US%Z_to_m**2)*US%s_to_T) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, & + scale=(US%Z_to_m**2)*US%s_to_T) endif @@ -1528,8 +1530,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,K) - Kd_heat(i,j,k) = Kd_int(i,j,K) + Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) @@ -1560,18 +1562,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = US%T_to_s * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - US%s_to_T * Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - US%s_to_T * Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1582,8 +1584,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, & + scale=(US%Z_to_m**2)*US%s_to_T) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, & + scale=(US%Z_to_m**2)*US%s_to_T) endif endif ! endif for KPP @@ -1595,7 +1599,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,k) visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1662,7 +1666,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_int(i,j,K) + ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * (US%s_to_T * Kd_int(i,j,K)) eb(i,j,k-1) = ea(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1676,8 +1680,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en 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 + ! XXX: Need to remove those US%s_to_T array multiply ops call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=US%s_to_T*Kd_lay, Kd_int=Kd_int) + ea, eb, kb, Kd_Lay=US%s_to_T*Kd_lay, Kd_int=US%s_to_T*Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -1749,11 +1754,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * Kd_add_here ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s * Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s * Kd_int(i,j,K) enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 60d577598a..095d4df030 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -227,7 +227,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 s-1 ~> m2 s-1]. + optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 T-1 ~> m2 s-1]. ! local variables real, dimension(SZI_(G)) :: & @@ -449,10 +449,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5 * US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = (US%T_to_s * visc%Kd_shear(i,j,K)) + 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = US%T_to_s * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif @@ -462,10 +462,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & else if (present(Kd_int)) then do i=is,ie - Kd_int(i,j,1) = US%s_to_T * Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 + Kd_int(i,j,1) = Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 enddo do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = 0.5 * US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo endif endif @@ -518,7 +518,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & 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(i,j,K) = max(Kd_int(i,j,K) , & ! Apply floor to Kd - US%s_to_T * dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) enddo ; enddo ; endif endif @@ -561,7 +561,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (present(Kd_int)) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + US%s_to_T * CS%Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else @@ -1162,7 +1162,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1]. ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1315,11 +1315,11 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else Kd_lay(i,j,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) endif - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5* (US%s_to_T * delta_Kd) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 *(US%s_to_T * delta_Kd) + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * (US%s_to_T * delta_Kd) endif endif else @@ -1342,8 +1342,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,j,k) = Kd_lay(i,j,k) + delta_Kd - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%s_to_T * delta_Kd) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * (US%s_to_T * delta_Kd) @@ -1392,7 +1392,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(inout) :: Kd_int !< Interface net diffusivity [Z2 s-1 ~> m2 s-1] + intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1] ! Local variables @@ -1520,7 +1520,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. - Kd_int(i,j,K) = Kd_int(i,j,K) + (US%s_to_T * Kd_wall) + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = (US%s_to_T * Kd_wall) @@ -1548,7 +1548,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. ! This routine adds effects of mixed layer radiation to the layer diffusivities. @@ -1624,10 +1624,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + (US%s_to_T * Kd_mlr_ml(i)) + Kd_int(i,j,K) = Kd_int(i,j,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,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5 * (US%s_to_T * Kd_mlr_ml(i)) + Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5 * Kd_mlr_ml(i) endif ; enddo ; endif endif @@ -1645,8 +1645,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%s_to_T * Kd_mlr) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%s_to_T * Kd_mlr) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * Kd_mlr + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * Kd_mlr endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 664860c6b1..3a311425b2 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -677,7 +677,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, - !! [Z2 s-1 ~> m2 s-1]. + !! [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]. @@ -947,7 +947,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes !! [Z2 s-1 ~> m2 s-1]. @@ -1195,8 +1195,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s) * Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) endif ! diagnostics @@ -1282,8 +1282,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s) * Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) endif ! diagnostics From a06cb9cbc159049f29a48a3eaf146c79852b5c5c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 13 May 2019 10:29:21 -0400 Subject: [PATCH 050/106] MOM_set_diffusivity time scaling: Kd_BBl + diag --- .../vertical/MOM_set_diffusivity.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 095d4df030..fb29b3a5e7 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1163,7 +1163,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, !! [Z2 T-1 ~> m2 s-1]. - real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1]. + real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1]. ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1318,8 +1318,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * (US%s_to_T * delta_Kd) + 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 endif endif else @@ -1345,8 +1345,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5 * (US%s_to_T * delta_Kd) - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5 * (US%s_to_T * delta_Kd) + 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 endif endif endif @@ -1393,7 +1393,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] - real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1] + real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1] ! Local variables real :: TKE_column ! net TKE input into the column [m3 T-3 ~> m3 s-3] @@ -1523,7 +1523,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. - if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = (US%s_to_T * Kd_wall) + if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall enddo ! k enddo ! i @@ -2065,7 +2065,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL endif CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, & - 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Bottom Boundary Layer Diffusivity', 'm2 s-1', & + conversion=(US%Z_to_m**2)*US%s_to_T) 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\n"//& "work for arbitrary vertical coordinates. If false,\n"//& From 91d2bcd4f177c35dc9220d07a97ee111e13febbd Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 13 May 2019 11:18:30 -0400 Subject: [PATCH 051/106] Time scaling: entrainment_diffusive kd_(lay|int) Array operations for rescaling kd_lay and kd_int in the Entrainment_diffusive call were replaced with internal rescaling of the variables. --- .../vertical/MOM_bkgnd_mixing.F90 | 6 +++--- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 16 +++++++++------- .../vertical/MOM_tidal_mixing.F90 | 2 +- 4 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index d5ba075d1f..580f3607f0 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -380,7 +380,7 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -389,7 +389,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers [T-2 ~> s-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd_lay !< Diapycnal diffusivity of each layer !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 s-1 ~> m2 s-1] @@ -506,7 +506,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) CS%kv_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) * CS%prandtl_bkgnd ! Update Kd (uniform profile; no interpolation needed) - kd_lay(i,j,:) = US%T_to_s * CS%kd_bkgnd(i,j,1) + Kd_lay(i,j,:) = US%T_to_s * CS%kd_bkgnd(i,j,1) enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 578c6a2a61..1854dc1f29 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1682,7 +1682,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb ! XXX: Need to remove those US%s_to_T array multiply ops call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=US%s_to_T*Kd_lay, Kd_int=US%s_to_T*Kd_int) + 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)") diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 824bab78b2..e8916ce727 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -79,10 +79,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! At least one of the two following arguments must be present. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. ! This subroutine calculates ea and eb, the rates at which a layer entrains ! from the layers above and below. The entrainment rates are proportional to @@ -271,23 +271,25 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (dt*Kd_lay(i,j,k)) + dtKd(i,k) = GV%Z_to_H**2 * (dt * (US%s_to_T * Kd_lay(i,j,k))) enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt * (US%s_to_T * Kd_int(i,j,K))) enddo ; enddo else do K=2,nz ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (0.5*dt*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) + dtKd_int(i,K) = GV%Z_to_H**2 * (0.5 * dt & + * (US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)))) enddo ; enddo endif else ! Kd_int must be present, or there already would have been an error. do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1))) + dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt & + * (US%T_to_s * (Kd_int(i,j,K)+Kd_int(i,j,K+1)))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt * (US%T_to_s * Kd_int(i,j,K))) enddo ; enddo endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 3a311425b2..1ee5b9c654 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -705,7 +705,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_mixing_cs), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy - !! frequency at the interfaces [s-2]. + !! frequency at the interfaces [T-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & From af6c7f5bbff1d19f6a8ab55d712421f9b434306e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 13 May 2019 15:09:45 -0400 Subject: [PATCH 052/106] MOM_tidal mixing time scaling: input arguments Rescaling of input arguments which pass through to MOM_set_diffusivity. Calls to CVMix cannot be re-scaled, in particular the N2_int vector, so we pre-scale this into a temporary variable before passing to CVMix. Note that the CVMix scaling is untested, since we currently do not have any CVMix tidal tests. --- .../vertical/MOM_tidal_mixing.F90 | 77 +++++++++++-------- 1 file changed, 44 insertions(+), 33 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 1ee5b9c654..7c4698f27e 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -687,10 +687,10 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C 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, (US%s_to_T**2)*N2_int, Kd_lay, Kv) + call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) else - call add_int_tide_diffusivity(h, (US%s_to_T**2)*N2_bot, j, (US%T_to_s**2)*TKE_to_Kd, (US%s_to_T**3)*max_TKE, & - G, GV, US, CS, (US%s_to_T**2)*N2_lay, Kd_lay, Kd_int, US%s_to_T*Kd_max) + call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & + G, GV, US, CS, N2_lay, Kd_lay, Kd_int, US%s_to_T*Kd_max) endif endif end subroutine calculate_tidal_mixing @@ -705,7 +705,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_mixing_cs), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy - !! frequency at the interfaces [T-2]. + !! frequency at the interfaces [T-2 ~> s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -721,6 +721,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZK_(G)) :: cellHeight ! Height of cell centers [m] real, dimension(SZK_(G)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input ! to model coordinates + real, dimension(SZK_(G)+1) :: N2_int_i ! De-scaled interface buoyancy frequency [s-2] real, dimension(SZK_(G)) :: Schmittner_coeff real, dimension(SZK_(G)) :: h_m ! Cell thickness [m] real, allocatable, dimension(:,:) :: exp_hab_zetar @@ -768,9 +769,14 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) Simmons_coeff = Simmons_coeff / CS%Gamma_itides + ! XXX: Temporary de-scaling of N2_int(i,:) into a temporary variable + do k = 1,G%ke+1 + N2_int_i(k) = US%s_to_T**2 * N2_int(i,k) + enddo + call CVMix_coeffs_tidal( Mdiff_out = Kv_tidal, & Tdiff_out = Kd_tidal, & - Nsqr = N2_int(i,:), & + Nsqr = N2_int_i, & OceanDepth = -iFaceHeight(G%ke+1),& SimmonsCoeff = Simmons_coeff, & vert_dep = vert_dep, & @@ -781,7 +787,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m_to_Z**2 * US%T_to_s * (Kd_tidal(k) + Kd_tidal(k+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo ! Update viscosity with the proper unit conversion. @@ -864,10 +870,14 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) exp_hab_zetar = exp_hab_zetar, & CVmix_tidal_params_user = CS%CVMix_tidal_params) + ! XXX: Temporary de-scaling of N2_int(i,:) into a temporary variable + do k = 1,G%ke+1 + N2_int_i(k) = US%s_to_T**2 * N2_int(i,k) + enddo call CVMix_coeffs_tidal_schmittner( Mdiff_out = Kv_tidal, & Tdiff_out = Kd_tidal, & - Nsqr = N2_int(i,:), & + Nsqr = N2_int_i, & OceanDepth = -iFaceHeight(G%ke+1), & vert_dep = vert_dep, & nlev = G%ke, & @@ -879,7 +889,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m_to_Z**2 * US%T_to_s * (Kd_tidal(k) + Kd_tidal(k+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo ! Update viscosity @@ -931,17 +941,17 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency - !! frequency [s-2]. + !! frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the - !! layers [s-2]. + !! layers [T-2 ~> s-2]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] + !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [m3 s-3] + !! to its maximum realizable thickness [m3 T-3 ~> m3 s-3] type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. @@ -1024,8 +1034,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & 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) + CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) + if (associated(dd%N2_bot)) dd%N2_bot(i,j) = US%s_to_T**2 * 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))) @@ -1050,7 +1060,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! WKB scaling of the vertical coordinate do i=is,ie ; N2_meanz(i)=0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_Z*h(i,j,k) + N2_meanz(i) = N2_meanz(i) + (US%s_to_T**2 * N2_lay(i,k)) * GV%H_to_Z * h(i,j,k) enddo ; enddo do i=is,ie N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) @@ -1061,12 +1071,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie ; htot_WKB(i) = htot(i) ; enddo ! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo ! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) +! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) ! enddo ; enddo ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler do i=is,ie - CS%Nb(i,j) = sqrt(N2_bot(i)) + CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) !### In the code below 1.0e-14 is a dimensional constant in [s-3] if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then @@ -1118,7 +1128,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, z_from_bot(i) = GV%H_to_Z*h(i,j,nz) ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant. - z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * (US%s_to_T**2 * N2_lay(i,nz)) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif enddo endif ! Polzin @@ -1176,8 +1186,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)* TKE_frac_top_lowmode(i) ! Actual power expended may be less than predicted if stratification is weak; adjust - if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then - frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (US%s_to_T**3 * max_TKE(i,k))) then + frac_used = (US%s_to_T**3 * max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) TKE_itide_lay = frac_used * TKE_itide_lay TKE_Niku_lay = frac_used * TKE_Niku_lay TKE_lowmode_lay = frac_used * TKE_lowmode_lay @@ -1189,10 +1199,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = (US%T_to_s**2 * TKE_to_Kd(i,k)) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s) * Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) @@ -1203,7 +1213,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, if (associated(dd%Kd_itidal)) then ! If at layers, 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 + Kd_add = (US%T_to_s**2 * 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 (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 (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 (k 1.0e-14 ) then - z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) + z_from_bot_WKB(i) = z_from_bot_WKB(i) & + + GV%H_to_Z * h(i,j,k) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif ! Fraction of bottom flux predicted to reach top of this layer @@ -1263,8 +1274,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)*TKE_frac_top_lowmode(i) ! Actual power expended may be less than predicted if stratification is weak; adjust - if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then - frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (US%s_to_T**3 * max_TKE(i,k))) then + frac_used = (US%s_to_T**3 * max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) TKE_itide_lay = frac_used * TKE_itide_lay TKE_Niku_lay = frac_used * TKE_Niku_lay TKE_lowmode_lay = frac_used * TKE_lowmode_lay @@ -1276,10 +1287,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = (US%T_to_s**2 * TKE_to_Kd(i,k)) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s) * Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) @@ -1290,7 +1301,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, if (associated(dd%Kd_itidal)) then ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay + Kd_add = (US%T_to_s**2 * 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 (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 (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 (k Date: Mon, 13 May 2019 15:49:00 -0400 Subject: [PATCH 053/106] MOM_set_diffusivity scaling: use kd scaling factor --- .../vertical/MOM_bkgnd_mixing.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 53 +++++++++---------- 2 files changed, 27 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 580f3607f0..7bf23fa63e 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -447,7 +447,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) CS%Kd_bkgnd(i,j,K) = US%m_to_Z**2*Kd_col(K) enddo do k=1,nz - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m_to_Z**2 * US%T_to_s * (Kd_col(K) + Kd_col(K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index fb29b3a5e7..5e566eb235 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -283,7 +283,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & I_Rho0 = 1.0 / GV%Rho0 ! ### Dimensional parameters - kappa_fill = 1.e-3 * US%m_to_Z**2 * US%T_to_s + kappa_fill = 1.e-3 * US%m2_s_to_Z2_T dt_fill = 7200. * US%s_to_T Omega2 = CS%omega * CS%omega @@ -532,7 +532,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%debug) then call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & - scale=(US%Z_to_m**2)*US%s_to_T) + scale=US%Z2_T_to_m2_s) if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z_to_m**2) @@ -1990,7 +1990,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "radiated from the base of the mixed layer. \n"//& "This is only used if ML_RADIATION is true.", & units="m2 s-1", default=1.0e-3, & - scale=(US%m_to_Z**2)*(US%T_to_s)) + scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& "the energy available for mixing below the base of the \n"//& @@ -2066,7 +2066,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z endif CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, & 'Bottom Boundary Layer Diffusivity', 'm2 s-1', & - conversion=(US%Z_to_m**2)*US%s_to_T) + conversion=US%Z2_T_to_m2_s) 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\n"//& "work for arbitrary vertical coordinates. If false,\n"//& @@ -2080,29 +2080,29 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", scale=(US%m_to_Z**2)*US%T_to_s, & + units="m2 s-1", scale=US%m2_s_to_Z2_T, & fail_if_missing=.true.) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", scale=(US%m_to_Z**2)*US%T_to_s, & + "may be used.", units="m2 s-1", scale=US%m2_s_to_Z2_T, & fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, & - scale=(US%m_to_Z**2)*(US%T_to_s)) + units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, & + scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& "negative value for no limit.", units="m2 s-1", default=-1.0, & - scale=(US%m_to_Z**2)*(US%T_to_s)) + scale=US%m2_s_to_Z2_T) if (CS%simple_TKE_to_Kd .and. 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, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added \n"//& "everywhere without any filtering or scaling.", & - units="m2 s-1", default=0.0, scale=(US%m_to_Z**2)*US%T_to_s) + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") @@ -2121,9 +2121,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", & - default=CS%Kd*(US%Z_to_m**2)*US%s_to_T, & - scale=(US%m_to_Z**2)*US%T_to_s) + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, & + scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -2140,21 +2139,21 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor).", units="W m-3", default=0.0, & - scale=(US%m_to_Z**2)*(US%T_to_s**3)) + scale=US%m2_s_to_Z2_T*(US%T_to_s**2)) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression \n"//& "used to set a minimum dissipation by which to determine \n"//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & units="W m-3", default=0.0, & - scale=(US%m_to_Z**2)*(US%T_to_s)**3) + scale=US%m2_s_to_Z2_T*(US%T_to_s**2)) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0, scale=(US%m_to_Z**2)*(US%T_to_s**2)) + units="J m-3", default=0.0, scale=US%m2_s_to_Z2_T*US%T_to_s) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & - units="m2 s-1", default=0.0, scale=(US%m_to_Z**2)*US%T_to_s) + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. & (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) @@ -2164,7 +2163,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', & - conversion=(US%Z_to_m**2)*(US%s_to_T)) + conversion=US%Z2_T_to_m2_s) if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & @@ -2176,7 +2175,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z 'Maximum layer TKE', 'm3 s-3', conversion=US%s_to_T**3) CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & 'Convert TKE to Kd', 's2 m', & - conversion=(US%Z_to_m**2)*(US%T_to_s**2)) + conversion=US%Z2_T_to_m2_s*(US%T_to_s**3)) CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency', & @@ -2193,7 +2192,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%s_to_T**2) if (CS%user_change_diff) & CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=(US%Z_to_m**2)*US%s_to_T) + conversion=US%Z2_T_to_m2_s) endif endif @@ -2208,36 +2207,36 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z default=2.55, units="nondim") call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & "Maximum salt diffusivity for salt fingering regime.", & - default=1.e-4, units="m2 s-1", scale=(US%m_to_Z**2)*US%T_to_s) + default=1.e-4, units="m2 s-1", scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & "Molecular viscosity for calculation of fluxes under \n"//& "double-diffusive convection.", default=1.5e-6, units="m2 s-1", & - scale=(US%m_to_Z**2)*US%T_to_s) + scale=US%m2_s_to_Z2_T) ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. CS%id_KT_extra = register_diag_field('ocean_model', 'KT_extra', diag%axesTi, Time, & 'Double-diffusive diffusivity for temperature', 'm2 s-1', & - conversion=(US%Z_to_m**2)*US%s_to_T) + conversion=US%Z2_T_to_m2_s) CS%id_KS_extra = register_diag_field('ocean_model', 'KS_extra', diag%axesTi, Time, & 'Double-diffusive diffusivity for salinity', 'm2 s-1', & - conversion=(US%Z_to_m**2)*US%s_to_T) + conversion=US%Z2_T_to_m2_s) if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & z_grid='z') CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=(US%Z_to_m**2)*US%s_to_T) + conversion=US%Z2_T_to_m2_s) vd = var_desc("KS_extra", "m2 s-1", & "Double-Diffusive Salinity Diffusivity, interpolated to z", & z_grid='z') CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=(US%Z_to_m**2)*US%s_to_T) + conversion=US%Z2_T_to_m2_s) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=(US%Z_to_m**2)*US%s_to_T) + conversion=US%Z2_T_to_m2_s) endif endif ! old double-diffusion From 492ebb6b32b2a8f51fe3b88fe1cee4b0c7137c36 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 May 2019 20:00:40 +0000 Subject: [PATCH 054/106] Switching from moab to slurm queue scheduler --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 7ad78049f3..e5af9feb36 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -116,8 +116,8 @@ run: - time tar zxf $CACHE_DIR/build-intel-repro-$CI_PIPELINE_ID.tgz - time tar zxf $CACHE_DIR/build-pgi-repro-$CI_PIPELINE_ID.tgz # time tar zxf $CACHE_DIR/build-gnu-debug-$CI_PIPELINE_ID.tgz - - echo "make -f MRS/Makefile.tests all -B" > job.sh - - msub -l partition=c4,nodes=29,walltime=00:31:00,qos=norm -q debug -S /bin/tcsh -j oe -A gfdl_o -z -o log.$CI_PIPELINE_ID -N mom6_regression -K job.sh + - (echo '#!/bin/tcsh';echo 'make -f MRS/Makefile.tests all -B') > job.sh + - sbatch --clusters=c3,c4 --nodes=29 --time=0:34:00 --account=gfdl_o --qos=debug --job-name=mom6_regressions --output=log.$CI_PIPELINE_ID --wait job.sh - cat log.$CI_PIPELINE_ID - test -f restart_results_gnu.tar.gz - time tar zvcf $CACHE_DIR/results-$CI_PIPELINE_ID.tgz *.tar.gz From 9532c7e2dfa2fa06563dd634c0a757fce3eadf1d Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 13 May 2019 20:53:23 -0400 Subject: [PATCH 055/106] User diffusivity time rescaling --- .../vertical/MOM_set_diffusivity.F90 | 10 +++++----- src/user/user_change_diffusivity.F90 | 11 ++++++----- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 5e566eb235..c6ddc10925 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -171,12 +171,12 @@ module MOM_set_diffusivity type diffusivity_diags real, pointer, dimension(:,:,:) :: & N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [T-2 ~> s-2] - Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 s-1 ~> m2 s-1] - Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 s-1 ~> m2 s-1] + Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 T-1 ~> m2 s-1] + Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 T-1 ~> m2 s-1] Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [kg T-3 ~> W m-2] maxTKE => NULL(), & !< energy required to entrain to h_max [m3 s-3] - KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 s-1 ~> m2 s-1]. - KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 s-1 ~> m2 s-1]. + KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 T-1 ~> m2 s-1]. + KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE !! dissipated within a layer and Kd in that layer @@ -2184,7 +2184,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z if (CS%user_change_diff) & CS%id_Kd_user = register_diag_field('ocean_model', 'Kd_user', diag%axesTi, Time, & - 'User-specified Extra Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'User-specified Extra Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (associated(diag_to_Z_CSp)) then vd = var_desc("N2", "s-2", & diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 5a29614506..9cb92ebc3c 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -26,7 +26,7 @@ module user_change_diffusivity !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private real :: Kd_add !< The scale of a diffusivity that is added everywhere - !! without any filtering or scaling [Z2 s-1 ~> m2 s-1]. + !! without any filtering or scaling [Z2 T-1 ~> m2 s-1]. real :: lat_range(4) !< 4 values that define the latitude range over which !! a diffusivity scaled by Kd_add is added [degLat]. real :: rho_range(4) !< 4 values that define the coordinate potential @@ -53,16 +53,16 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a !! fields. Absent fields have NULL ptrs. type(user_change_diff_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of - !! each layer [Z2 s-1 ~> m2 s-1]. + !! each layer [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity - !! at each interface [Z2 s-1 ~> m2 s-1]. + !! at each interface [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless !! layers filled in vertically [ppt]. real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at - !! each interface [Z2 s-1 ~> m2 s-1]. + !! each interface [Z2 T-1 ~> m2 s-1]. ! Local variables real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers [kg m-3]. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. @@ -222,7 +222,8 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "USER_KD_ADD", CS%Kd_add, & "A user-specified additional diffusivity over a range of \n"//& - "latitude and density.", default=0.0, units="m2 s-1", scale=US%m_to_Z**2) + "latitude and density.", default=0.0, units="m2 s-1", & + scale=US%m2_s_to_Z2_T) if (CS%Kd_add /= 0.0) then call get_param(param_file, mdl, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), & "Four successive values that define a range of latitudes \n"//& From df4c25513f10102b49587908d5c420ce4520e09e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 13 May 2019 21:49:28 -0400 Subject: [PATCH 056/106] MOM_set_diffusivity comment/whitespace updates --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c6ddc10925..ba792493b2 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -174,7 +174,7 @@ module MOM_set_diffusivity Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 T-1 ~> m2 s-1] Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 T-1 ~> m2 s-1] Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [kg T-3 ~> W m-2] - maxTKE => NULL(), & !< energy required to entrain to h_max [m3 s-3] + maxTKE => NULL(), & !< energy required to entrain to h_max [m3 T-3 ~> m3 s-3] KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 T-1 ~> m2 s-1]. KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() @@ -252,8 +252,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] dRho_int, & !< locally ref potential density difference across interfaces [kg m-3] - KT_extra, & !< double difusion diffusivity of temperature [Z2 s-1 ~> m2 s-1] - KS_extra !< double difusion diffusivity of salinity [Z2 s-1 ~> m2 s-1] + KT_extra, & !< double difusion diffusivity of temperature [Z2 T-1 ~> m2 s-1] + KS_extra !< double difusion diffusivity of salinity [Z2 T-1 ~> m2 s-1] real :: I_Rho0 ! inverse of Boussinesq density [m3 kg-1] real :: dissip ! local variable for dissipation calculations [Z2 kg m-3 T-3 ~> W m-3] @@ -337,8 +337,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(tv%S, "before vert_fill_TS tv%S",G%HI) call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m) endif - call vert_fill_TS(h, tv%T, tv%S, kappa_fill, & - dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, kappa_fill, dt_fill, T_f, S_f, G, GV) if (CS%debug) then call hchksum(tv%T, "after vert_fill_TS tv%T",G%HI) call hchksum(tv%S, "after vert_fill_TS tv%S",G%HI) From a5729888964c23066d15dbbeb02df74b3eaeae32 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 May 2019 21:20:55 +0000 Subject: [PATCH 057/106] Avoid division by zero when Ah_time_scale=0 - New viscosity option had potential division by zero - No answer changes --- src/parameterizations/lateral/MOM_hor_visc.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 24a2c613d5..1b031df73c 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1469,8 +1469,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) - CS%Ah_bg_xx(i,j) = MAX(CS%Ah_bg_xx(i,j), (grid_sp_h2 * grid_sp_h2) / & - Ah_time_scale) + if (Ah_time_scale>0.) CS%Ah_bg_xx(i,j) = & + MAX(CS%Ah_bg_xx(i,j), (grid_sp_h2 * grid_sp_h2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xx(i,j) = Ah_Limit * (grid_sp_h2 * grid_sp_h2) CS%Ah_bg_xx(i,j) = MIN(CS%Ah_bg_xx(i,j), CS%Ah_Max_xx(i,j)) @@ -1493,8 +1493,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) - CS%Ah_bg_xy(i,j) = MAX(CS%Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / & - Ah_time_scale) + if (Ah_time_scale>0.) CS%Ah_bg_xy(i,j) = & + MAX(CS%Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xy(I,J) = Ah_Limit * (grid_sp_q2 * grid_sp_q2) CS%Ah_bg_xy(I,J) = MIN(CS%Ah_bg_xy(I,J), CS%Ah_Max_xy(I,J)) From 45a706cded2c4553da8df69c75fbadb0d6446067 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 May 2019 23:36:58 +0000 Subject: [PATCH 058/106] Add control of MEKE viscosity scaling to recover old answers - Commit db98e9e rearranged the order of limiting and resolution scaling in order to have the MEKE contribution to viscosity be scaled by the resolution functon. This changed answers in many configurations even those not using MEKE. - This adds a flag that defaults to the non-answer changing mode of not resolution scaling the MEKE contribution but does recover the desired result when set to Tree. --- .../lateral/MOM_hor_visc.F90 | 26 ++++++++++++++----- 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1b031df73c..594e4d9e9c 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -71,6 +71,8 @@ module MOM_hor_visc real :: Kh_aniso !< The anisotropic viscosity [m2 s-1]. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. + logical :: res_scale_MEKE !< If true, the viscosity contribution from MEKE is scaled by + !! the resolution function. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx !< The background Laplacian viscosity at h points [m2 s-1]. !! The actual viscosity may be the larger of this @@ -267,6 +269,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: RoScl ! The scaling function for MEKE source term [nondim] real :: FatH ! abs(f) at h-point for MEKE source term [s-1] real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. + real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. logical :: rescale_Kh, legacy_bound logical :: find_FrictWork @@ -327,6 +330,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & + !$OMP meke_res_fn, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz @@ -558,6 +562,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif; endif endif + meke_res_fn = 1. + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & @@ -583,12 +589,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xx(i,j) * Shear_mag ) if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xx(i,j) * Vort_mag ) - Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. - if (use_MEKE_Ku) Kh = Kh + MEKE%Ku(i,j) ! *Add* the MEKE contribution (might be negative) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh + if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_h(i,j) ! Older method of bounding for stability if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) + Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. + if (use_MEKE_Ku) Kh = Kh + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -691,6 +698,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ; endif endif + meke_res_fn = 1. + do J=js-1,Jeq ; do I=is-1,Ieq if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then Shear_mag = sqrt(sh_xy(I,J)*sh_xy(I,J) + & @@ -743,15 +752,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%LAPLAC_CONST_xy(I,J) * Shear_mag ) if (CS%Leith_Kh) Kh = max( Kh, CS%LAPLAC3_CONST_xy(I,J) * Vort_mag) + ! All viscosity contributions above are subject to resolution scaling + if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh + if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_q(i,j) + ! Older method of bounding for stability + if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) Kh = max( Kh, 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 = Kh + 0.25*( (MEKE%Ku(I,J)+MEKE%Ku(I+1,J+1)) & - +(MEKE%Ku(I+1,J)+MEKE%Ku(I,J+1)) ) + +(MEKE%Ku(I+1,J)+MEKE%Ku(I,J+1)) ) * meke_res_fn endif - ! All viscosity contributions above are subject to resolution scaling - if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh ! Older method of bounding for stability - if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! *Add* the shear component ! of anisotropic viscosity @@ -1090,6 +1101,9 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "If true, add a term to Leith viscosity which is \n"//& "proportional to the gradient of divergence.", & default=.false.) + 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.) if (CS%Leith_Kh .or. get_all) & call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & From de06f1b7327b64ec9f7d01c63a870fe8d71c4684 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 16 May 2019 16:47:28 +0000 Subject: [PATCH 059/106] Corrected indentation to fit code style guide - As pointed out by @Hallberg-NOAA, some indentations were off. (flint is coming) --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index c20d6f3e55..24b44fab9f 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -856,15 +856,15 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%L2u(IsdB:IedB,jsd:jed)) ; CS%L2u(:,:) = 0.0 allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 if (CS%Visbeck_L_scale<0) then - do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2*G%areaCu(I,j) - enddo; enddo - do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2*G%areaCv(i,J) - enddo; enddo + do j=js,je ; do I=is-1,Ieq + CS%L2u(I,j) = CS%Visbeck_L_scale**2*G%areaCu(I,j) + enddo; enddo + do J=js-1,Jeq ; do i=is,ie + CS%L2v(i,J) = CS%Visbeck_L_scale**2*G%areaCv(i,J) + enddo; enddo else - CS%L2u(:,:) = CS%Visbeck_L_scale**2 - CS%L2v(:,:) = CS%Visbeck_L_scale**2 + CS%L2u(:,:) = CS%Visbeck_L_scale**2 + CS%L2v(:,:) = CS%Visbeck_L_scale**2 endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & From 78d2dc3ee9a018f30bc666bd574e21fb7786403d Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 16 May 2019 16:41:56 -0400 Subject: [PATCH 060/106] (*) MOM_mixed_layer_restrat [uv]Dml_diag index fix This patch resolves a few issues related to the uDml_diag and vDml diagnostics in the MOM_mixed_layer_restrat module. In both cases, the index loops were not including the starting values (is-1 for uDml and js-1 for vDml). In `mixedlayer_restrat_BML`, uDml_diag(is-1,:) was never assigned a value, since only the uDml(is:ie,:) values were copied to uDml_diag. This produced volatile answers along these records. There were no known issues with vDml, since is:ie spans the vector, but we have nonetheless moved the vector copy inside of the loop. We have introduced the following changes: * [uv]Dml_diag is now evaluated in the loop, rather than relying on a vector copy, since there are no dependencies within the loop. * [uv]timescale_diag are no longer initialised within the outer loop, since their values are explicitly set. * The I and J loops are now fully nested (with whitespace changes) In `mixedlayer_restrat_general`, we now include the edge cases uDml(is-1,:) and vDml(:,js-1) in surface velocity estimates. In both functions, some half-index notation (ij->IJ) was corrected within the loops. The following diagnostics may change value: * udml_restrat * vdml_restrat * uml_restrat * vml_restrat --- .../lateral/MOM_mixed_layer_restrat.F90 | 103 +++++++++--------- 1 file changed, 49 insertions(+), 54 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index eef2a2f954..9077dd0f18 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -524,14 +524,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%id_vDml > 0) call post_data(CS%id_vDml, vDml_diag, CS%diag) if (CS%id_uml > 0) then - do J=js,je ; do i=is,ie + do J=js,je ; do i=is-1,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_uml, uDml_diag, CS%diag) endif if (CS%id_vml > 0) then - do J=js,je ; do i=is,ie + do J=js-1,je ; do i=is,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) enddo ; enddo @@ -650,54 +650,50 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! U - Component !$OMP do - do j=js,je - do i=is,ie ; utimescale_diag(i,j) = 0.0 ; enddo - do i=is,ie ; vtimescale_diag(i,j) = 0.0 ; enddo - do I=is-1,ie - h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) - ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) - ! momentum mixing rate: pi^2*visc/h_ml^2 - ! 0.41 is the von Karmen constant, 9.8696 = pi^2. - mom_mixrate = (0.41*9.8696)*u_star**2 / & - (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) - timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) - - timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) + do j=js,je; do I=is-1,ie + h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - utimescale_diag(I,j) = timescale - - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) - - if (uDml(i) == 0) then - do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo - else - I2htot = 1.0 / (htot(i,j) + htot(i+1,j) + h_neglect) - z_topx2 = 0.0 - ! a(k) relates the sublayer transport to uDml with a linear profile. - ! The sum of a(k) through the mixed layers must be 0. - do k=1,nkml - hx2 = (h(i,j,k) + h(i+1,j,k) + h_neglect) - a(k) = (hx2 * I2htot) * (2.0 - 4.0*(z_topx2+0.5*hx2)*I2htot) - z_topx2 = z_topx2 + hx2 - if (a(k)*uDml(I) > 0.0) then - if (a(k)*uDml(I) > h_avail(i,j,k)) uDml(I) = h_avail(i,j,k) / a(k) - else - if (-a(k)*uDml(I) > h_avail(i+1,j,k)) uDml(I) = -h_avail(i+1,j,k)/a(k) - endif - enddo - do k=1,nkml - uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt - enddo - endif - enddo - uDml_diag(is:ie,j) = uDml(is:ie) - enddo + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! momentum mixing rate: pi^2*visc/h_ml^2 + ! 0.41 is the von Karmen constant, 9.8696 = pi^2. + mom_mixrate = (0.41*9.8696)*u_star**2 / & + (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) + timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) + + timescale = timescale * CS%ml_restrat_coef +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) + + uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & + G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + + if (uDml(I) == 0) then + do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo + else + I2htot = 1.0 / (htot(i,j) + htot(i+1,j) + h_neglect) + z_topx2 = 0.0 + ! a(k) relates the sublayer transport to uDml with a linear profile. + ! The sum of a(k) through the mixed layers must be 0. + do k=1,nkml + hx2 = (h(i,j,k) + h(i+1,j,k) + h_neglect) + a(k) = (hx2 * I2htot) * (2.0 - 4.0*(z_topx2+0.5*hx2)*I2htot) + z_topx2 = z_topx2 + hx2 + if (a(k)*uDml(I) > 0.0) then + if (a(k)*uDml(I) > h_avail(i,j,k)) uDml(I) = h_avail(i,j,k) / a(k) + else + if (-a(k)*uDml(I) > h_avail(i+1,j,k)) uDml(I) = -h_avail(i+1,j,k)/a(k) + endif + enddo + do k=1,nkml + uhml(I,j,k) = a(k)*uDml(I) + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + enddo + endif + + uDml_diag(I,j) = uDml(I) + utimescale_diag(I,j) = timescale + enddo; enddo ! V- component !$OMP do @@ -716,8 +712,6 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) - vtimescale_diag(i,J) = timescale - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then @@ -742,9 +736,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt enddo endif - enddo - vDml_diag(is:ie,j) = vDml(is:ie) - enddo + + vtimescale_diag(i,J) = timescale + vDml_diag(i,J) = vDml(i) + enddo; enddo !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie From 806e8d9a8410280f93b6d94c2bc8db105ad7c1cb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 May 2019 18:29:56 -0400 Subject: [PATCH 061/106] Rescaled 20 TKE-related variables Applied unit rescaling for dimensional consistency analysis to about 20 TKE-related variables on MOM_set_diffusivity and MOM_tidal_mixing. All answers are bitwise identical and these revised expressions pass the dimensional consistency tests for vertical height and time units. --- src/core/MOM_variables.F90 | 3 +- .../vertical/MOM_set_diffusivity.F90 | 116 ++++++++--------- .../vertical/MOM_tidal_mixing.F90 | 123 +++++++++--------- 3 files changed, 123 insertions(+), 119 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index f668f24508..3748684fd4 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -208,7 +208,8 @@ module MOM_variables ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z s-1 ~> m s-1]. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic - !! energy, currently in [m3 s-3], but will later be changed to [W m-2]. + !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed + !! to [kg Z3 m-3 T-3 ~> W m-2]. real, pointer, dimension(:,:) :: & taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [Pa]. tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [Pa]. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 93f1c33b06..c5fe83a9e7 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -173,14 +173,14 @@ module MOM_set_diffusivity N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [T-2 ~> s-2] Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 T-1 ~> m2 s-1] Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [kg T-3 ~> W m-2] - maxTKE => NULL(), & !< energy required to entrain to h_max [m3 T-3 ~> m3 s-3] + Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [kg Z3 m-3 T-3 ~> W m-2] + maxTKE => NULL(), & !< energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 T-1 ~> m2 s-1]. KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE !! dissipated within a layer and Kd in that layer - !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> T2 m-1] + !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] end type diffusivity_diags @@ -247,7 +247,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & maxTKE, & !< energy required to entrain to h_max [m3 T-3] TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between !< TKE dissipated within a layer and Kd in that layer - !< [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] + !< [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] @@ -395,7 +395,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call sfc_bkgnd_mixing(G, US, CS%bkgnd_mixing_csp) !$OMP parallel do default(shared) private(dRho_int, N2_lay, N2_int, N2_bot, KT_extra, & - !$OMP KS_extra, TKE_to_Kd,maxTKE, dissip, kb) + !$OMP KS_extra, TKE_to_Kd, maxTKE, dissip, kb) do j=js,je ! Set up variables related to the stratification. @@ -523,7 +523,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * (US%Z_to_m**3 * Kd_lay(i,j,k)) * N2_lay(i,k) * & + dd%Kd_Work(i,j,k) = GV%Rho0 * Kd_lay(i,j,k) * N2_lay(i,k) * & GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3 enddo ; enddo endif @@ -680,9 +680,9 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] + !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [m3 T-3] + !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. ! Local variables @@ -736,13 +736,13 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = US%Z_to_m**3 * (GV%H_to_Z * h(i,j,k)) * (N2_lay(i,k) + Omega2) ! Units of m3 Z-2 T-2. + hN2pO2 = (GV%H_to_Z * h(i,j,k)) * (N2_lay(i,k) + Omega2) ! Units of Z T-2. if (hN2pO2>0.) then - TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. + TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of T2 Z-1. else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of m3 T-3. + maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of Z3 T-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -837,7 +837,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & enddo do k=2,kmb ; do i=is,ie maxTKE(i,k) = 0.0 - TKE_to_Kd(i,k) = US%m_to_Z**3 / ((N2_lay(i,k) + Omega2) * & + TKE_to_Kd(i,k) = 1.0 / ((N2_lay(i,k) + Omega2) * & (GV%H_to_Z*(h(i,j,k) + H_neglect))) enddo ; enddo do k=kmb+1,kb_min-1 ; do i=is,ie @@ -858,10 +858,10 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) - maxTKE(i,k) = US%Z_to_m**3 * I_dt * (G_IRho0 * & + maxTKE(i,k) = I_dt * (G_IRho0 * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & - ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) - TKE_to_Kd(i,k) = US%m_to_Z**3 / (G_Rho0 * dRho_lay + & + ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) + TKE_to_Kd(i,k) = 1.0 / (G_Rho0 * dRho_lay + & CS%omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif enddo ; enddo @@ -1150,7 +1150,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] + !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum-realizable thickness [m3 T-3 ~> m3 s-3] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer @@ -1176,12 +1176,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! the local ustar, times R0_g [kg m-2] Rho_top, & ! density at top of the BBL [kg m-3] TKE, & ! turbulent kinetic energy available to drive - ! bottom-boundary layer mixing in a layer [m3 T-3 ~> m3 s-3] + ! bottom-boundary layer mixing in a layer [Z3 T-3 ~> m3 s-3] I2decay ! inverse of twice the TKE decay scale [Z-1 ~> m-1]. - real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 T-3 ~> m3 s-3] - real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [m3 T-3 ~> m3 s-3] - real :: TKE_here ! TKE that goes into mixing in this layer [m3 T-3 ~> m3 s-3] + real :: TKE_to_layer ! TKE used to drive mixing in a layer [Z3 T-3 ~> m3 s-3] + real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [Z3 T-3 ~> m3 s-3] + real :: TKE_here ! TKE that goes into mixing in this layer [Z3 T-3 ~> m3 s-3] real :: dRl, dRbot ! temporaries holding density differences [kg m-3] 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]. @@ -1230,12 +1230,11 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! If ustar_h = 0, this is land so this value doesn't matter. I2decay(i) = 0.5*CS%IMax_decay endif - TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * & - exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * & - (US%T_to_s**3 * visc%TKE_BBL(i,j)) + TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * & + visc%TKE_BBL(i,j) if (associated(fluxes%TKE_tidal)) & - TKE(i) = TKE(i) + (US%T_to_s**3 * fluxes%TKE_tidal(i,j)) * I_Rho0 * & + TKE(i) = TKE(i) + (US%T_to_s**3 * US%m_to_Z**3 * fluxes%TKE_tidal(i,j)) * I_Rho0 * & (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz)))) ! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following @@ -1286,14 +1285,14 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE_to_layer = TKE(i) else dRl = Rint(K+1) - Rint(K) ; dRbot = Rint(K+1) - Rho_top(i) - TKE_to_layer = TKE(i) * dRl * (3.0*dRbot*(Rint(K) - Rho_top(i)) +& - dRl**2) / dRbot**3 + TKE_to_layer = TKE(i) * dRl * & + (3.0*dRbot*(Rint(K) - Rho_top(i)) + dRl**2) / dRbot**3 endif else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%Z_to_m * G%IareaT(i,j) * & - US%T_to_s**3 * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & + US%m_to_Z**2 * US%T_to_s**3 * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1327,13 +1326,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) + TKE_Ray elseif (Kd_lay(i,j,k) + (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) > & maxTKE(i,k) * TKE_to_Kd(i,k)) then - TKE_here = ((TKE_to_layer + TKE_Ray) + Kd_lay(i,j,k) / TKE_to_Kd(i,k)) & - - maxTKE(i,k) + TKE_here = ((TKE_to_layer + TKE_Ray) + Kd_lay(i,j,k) / TKE_to_Kd(i,k)) - maxTKE(i,k) ! ### Non-bracketed ternary sum TKE(i) = TKE(i) - TKE_here + TKE_Ray else TKE_here = TKE_to_layer + TKE_Ray - TKE(i) = TKE(i) - TKE_to_Layer + TKE(i) = TKE(i) - TKE_to_layer endif if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? @@ -1395,11 +1393,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1] ! Local variables - real :: TKE_column ! net TKE input into the column [m3 T-3 ~> m3 s-3] - real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 T-3 ~> m3 s-3] - real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [m3 T-3 ~> m3 s-3] - real :: TKE_consumed ! TKE used for mixing in this layer [m3 T-3 ~> m3 s-3] - real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [m3 T-3 ~> m3 s-3] + real :: TKE_column ! net TKE input into the column [Z3 T-3 ~> m3 s-3] + real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [Z3 T-3 ~> m3 s-3] + real :: TKE_consumed ! TKE used for mixing in this layer [Z3 T-3 ~> m3 s-3] + real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [Z3 T-3 ~> m3 s-3] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar ! value of ustar at a thickness point [Z T-1 ~> m s-1]. real :: ustar2 ! square of ustar, for convenience [Z2 T-2 ~> m2 s-2] @@ -1450,13 +1447,14 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & Idecay = CS%IMax_decay if ((ustar > 0.0) .and. (absf > CS%IMax_decay * ustar)) Idecay = absf / ustar - ! Energy input at the bottom [m3 s-3]. - ! (Note that visc%TKE_BBL is in m3 s-3, set in set_BBL_TKE().) + ! Energy input at the bottom [Z3 T-3 ~> m3 s-3]. + ! (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 * (US%T_to_s**3 * visc%TKE_BBL(i,j)) + TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j) ! Add in tidal dissipation energy at the bottom [m3 s-3]. ! Note that TKE_tidal is in [W m-2]. - if (associated(fluxes%TKE_tidal)) TKE_column = TKE_column + (US%T_to_s**3 * fluxes%TKE_tidal(i,j)) * I_Rho0 + if (associated(fluxes%TKE_tidal)) & + TKE_column = TKE_column + US%m_to_Z**3*US%T_to_s**3 * fluxes%TKE_tidal(i,j) * I_Rho0 TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column @@ -1474,8 +1472,8 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & - US%T_to_s**3 * & - 0.5*CS%BBL_effic * US%Z_to_m * G%IareaT(i,j) * & + US%m_to_Z**2 * US%T_to_s**3 * & + 0.5*CS%BBL_effic * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1499,7 +1497,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! TKE associated with Kd_wall [m3 s-2]. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = US%Z_to_m**3 * Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall > 0.) then @@ -1544,7 +1542,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] + !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces !! [Z2 T-1 ~> m2 s-1]. @@ -1594,8 +1592,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, ustar_sq = max(US%T_to_s * fluxes%ustar(i,j), CS%ustar_min)**2 - TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) & - * (US%Z_to_m**3 * ustar_sq * (US%T_to_s * fluxes%ustar(i,j))) + TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (US%T_to_s * fluxes%ustar(i,j))) I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) if (CS%ML_rad_TKE_decay) & @@ -1611,8 +1608,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, if (z1 > 1e-5) then Kd_mlr = TKE_ml_flux(i) * TKE_to_Kd(i,kml+1) * (1.0 - exp(-z1)) else - Kd_mlr = TKE_ml_flux(i) * TKE_to_Kd(i,kml+1) & - * (z1 * (1.0 - z1 * (0.5 - C1_6 * z1))) + Kd_mlr = TKE_ml_flux(i) * TKE_to_Kd(i,kml+1) * (z1 * (1.0 - z1 * (0.5 - C1_6 * z1))) endif Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) @@ -1635,11 +1631,13 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) & - * US%m_to_Z * ((1.0 - exp(-z1)) / dzL) + !### I think that this might be dimensionally inconsistent, but untested. -RWH + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? + US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 ? else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) & - * US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) + !### I think that this might be dimensionally inconsistent, but untested. -RWH + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? + US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 ? endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1649,8 +1647,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) & - < 0.1 * CS%Kd_min * US%Z_to_m**3 * Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1 * CS%Kd_min * Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -1787,7 +1784,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = US%Z_to_m * & + visc%TKE_BBL(i,j) = US%T_to_s**3 * US%m_to_Z**2 * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & @@ -2169,12 +2166,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%tm_csp%Lowmode_itidal_dissipation) then CS%id_Kd_Work = register_diag_field('ocean_model', 'Kd_Work', diag%axesTL, Time, & - 'Work done by Diapycnal Mixing', 'W m-2', conversion=US%s_to_T**3) + 'Work done by Diapycnal Mixing', 'W m-2', conversion=US%Z_to_m**3*US%s_to_T**3) CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & - 'Maximum layer TKE', 'm3 s-3', conversion=US%s_to_T**3) + 'Maximum layer TKE', 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & 'Convert TKE to Kd', 's2 m', & - conversion=US%Z2_T_to_m2_s*(US%T_to_s**3)) + conversion=US%Z2_T_to_m2_s*(US%m_to_Z**3*US%T_to_s**3)) CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency', & @@ -2190,8 +2187,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "Buoyancy frequency, interpolated to z", z_grid='z') CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%s_to_T**2) if (CS%user_change_diff) & - CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=US%Z2_T_to_m2_s) + CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z2_T_to_m2_s) endif endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 2af17d734b..b82313dc6c 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -45,11 +45,11 @@ module MOM_tidal_mixing type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. - Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [m3 s-3] + Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. - Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [W m-2] - Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [W m-2] - Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [W m-2] + Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [kg Z3 m-3 T-3 ~> W m-2] + Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [kg Z3 m-3 T-3 ~> W m-2] + Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [kg Z3 m-3 T-3 ~> W m-2] N2_int => NULL(),& !< Bouyancy frequency squared at interfaces [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? @@ -58,9 +58,9 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces !! due to propagating low modes [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent - !! dissipation due to propagating low modes [m3 s-3] + !! 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 [W m-2] + TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [kg Z3 m-3 T-3 ~> W m-2] N2_bot => NULL(),& !< bottom squared buoyancy frequency [s-2] N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [s-2] Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation @@ -123,10 +123,10 @@ module MOM_tidal_mixing real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation !! profile in Polzin formulation [Z ~> m]. - real :: TKE_itide_max !< maximum internal tide conversion [W m-2] + real :: TKE_itide_max !< maximum internal tide conversion [kg Z3 m-3 T-3 ~> W m-2] !! available to mix above the BBL - real :: utide !< constant tidal amplitude [m s-1] used if + real :: utide !< constant tidal amplitude [Z T-1 ~> m s-1] if READ_TIDEAMP is false. real :: kappa_itides !< topographic wavenumber and non-dimensional scaling [Z-1 ~> m-1]. real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir !< The directory in which to find input files @@ -146,9 +146,10 @@ module MOM_tidal_mixing type(remapping_CS) :: remap_CS !< The control structure for remapping ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input [W m-2] + real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input + !! [kg Z3 m-3 T-3 ~> W m-2] real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratfication [J m-2]. + !! by the bottom stratfication [kg Z3 m-3 T-2 ~> J m-2]. real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [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 [m2]. @@ -421,7 +422,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ 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) + 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 call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & @@ -430,7 +431,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & "The maximum internal tide energy source available to mix \n"//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & - units="W m-2", default=1.0e3) + units="W m-2", default=1.0e3, scale=US%m_to_Z**3*US%T_to_s**3) call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & "If true, read a file (given by TIDEAMP_FILE) containing \n"//& @@ -445,7 +446,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, timelevel=1) + call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, timelevel=1, scale=US%m_to_Z*US%T_to_s) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -466,8 +467,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ CS%h2(i,j) = hamp*hamp utide = CS%tideamp(i,j) - ! Compute the fixed part of internal tidal forcing; units are [J m-2 = kg s-2] here. - CS%TKE_itidal(i,j) = 0.5*US%Z_to_m * CS%kappa_h2_factor*GV%Rho0*& + ! Compute the fixed part of internal tidal forcing; units are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. + CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%Rho0 * & CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -488,7 +489,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ 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 - call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1 ) ! ??? timelevel -aja + call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja + scale=US%m_to_Z**3*US%T_to_s**3) CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & @@ -582,21 +584,25 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ else CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & - 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') + 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & 'Bottom Buoyancy Frequency', 's-1') CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1', conversion=US%Z_to_m**2) + 'Internal Tide Driven Diffusivity (from propagating low modes)', & + 'm2 s-1', conversion=US%Z_to_m**2) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') + 'Vertical flux of tidal turbulent dissipation', & + 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') + 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', & + 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm', conversion=US%Z_to_m) + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', & + 'm', conversion=US%Z_to_m) CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & 'Polzin_decay_scale_scaled', diag%axesT1, Time, & @@ -610,17 +616,18 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ 'Buoyancy frequency squared averaged over the water column', 's-2') CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') + 'Work done by Internal Tide Diapycnal Mixing', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & - 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') + 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') + 'Work done by Internal Tide Diapycnal Mixing (low modes)', & + 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) if (CS%Lee_wave_dissipation) then CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & - 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') + 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) endif @@ -666,12 +673,12 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! interfaces [T-2 ~> s-2]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE - !! TKE dissipated within a layer and the - !! diapycnal diffusivity witin that layer, + !! dissipated within a layer and the + !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] + !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [m3 T-3 ~> m3 s-3] + !! 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),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. @@ -946,12 +953,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! layers [T-2 ~> s-2]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE - !! TKE dissipated within a layer and the - !! diapycnal diffusivity witin that layer, + !! dissipated within a layer and the + !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / m3 T-3 = Z2 T2 m-3 ~> s2 m-1] + !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [m3 T-3 ~> m3 s-3] + !! 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),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. @@ -969,9 +976,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, htot, & ! total thickness above or below a layer, or the ! integrated thickness in the BBL [Z ~> m]. htot_WKB, & ! WKB scaled distance from top to bottom [Z ~> m]. - TKE_itidal_bot, & ! internal tide TKE at ocean bottom [m3 s-3] - TKE_Niku_bot, & ! lee-wave TKE at ocean bottom [m3 s-3] - TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes [m3 s-3] (BDM) + TKE_itidal_bot, & ! internal tide TKE at ocean bottom [Z3 T-3 ~> m3 s-3] + TKE_Niku_bot, & ! lee-wave TKE at ocean bottom [Z3 T-3 ~> m3 s-3] + TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes [Z3 T-3 ~> m3 s-3] (BDM) Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean [nondim] Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean [nondim] Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean [nondim] (BDM) @@ -981,9 +988,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! 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 [s-2] for WKB scaling - TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) - TKE_Niku_rem, & ! remaining lee-wave TKE - TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) (BDM) + 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) TKE_frac_top, & ! fraction of bottom TKE that should appear at top of a layer [nondim] TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer [nondim] TKE_frac_top_lowmode, & @@ -993,14 +1000,14 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, real :: I_rho0 ! 1 / RHO0 [m3 kg-1] real :: Kd_add ! diffusivity to add in a layer [Z2 s-1 ~> m2 s-1]. - real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [m3 s-3] - real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [m3 s-3] - real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [m3 s-3] (BDM) + real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [Z3 T-3 ~> m3 s-3] + real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [Z3 T-3 ~> m3 s-3] + real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [Z3 T-3 ~> m3 s-3] (BDM) real :: frac_used ! fraction of TKE that can be used in a layer [nondim] real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]. real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]. real :: z0_psl ! temporary variable [Z ~> m]. - real :: TKE_lowmode_tot ! TKE from all low modes [W m-2] (BDM) + real :: TKE_lowmode_tot ! TKE from all low modes [kg Z3 m-3 T-3 ~> W m-2] (BDM) logical :: use_Polzin, use_Simmons character(len=160) :: mesg ! The text of an error message @@ -1080,9 +1087,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !### In the code below 1.0e-14 is a dimensional constant in [s-3] if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - z0_polzin(i) = US%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) + ( CS%kappa_itides**2 * CS%h2(i,j) * US%T_to_s * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & z0_polzin(i) = CS%Polzin_min_decay_scale if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2. @@ -1137,7 +1144,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! Both Polzin and Simmons: 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) + TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*US%T_to_s*CS%Nb(i,j), CS%TKE_itide_max) if (associated(dd%TKE_itidal_used)) & 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) @@ -1186,8 +1193,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)* TKE_frac_top_lowmode(i) ! Actual power expended may be less than predicted if stratification is weak; adjust - if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (US%s_to_T**3 * max_TKE(i,k))) then - frac_used = (US%s_to_T**3 * max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (max_TKE(i,k))) then + frac_used = (max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) TKE_itide_lay = frac_used * TKE_itide_lay TKE_Niku_lay = frac_used * TKE_Niku_lay TKE_lowmode_lay = frac_used * TKE_lowmode_lay @@ -1199,7 +1206,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = (US%T_to_s**2 * TKE_to_Kd(i,k)) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = US%s_to_T * TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) @@ -1213,7 +1220,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, if (associated(dd%Kd_itidal)) then ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = (US%T_to_s**2 * TKE_to_Kd(i,k)) * TKE_itide_lay + Kd_add = US%s_to_T * 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 (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 (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 (k (US%s_to_T**3 * max_TKE(i,k))) then - frac_used = (US%s_to_T**3 * max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (max_TKE(i,k))) then + frac_used = (max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) TKE_itide_lay = frac_used * TKE_itide_lay TKE_Niku_lay = frac_used * TKE_Niku_lay TKE_lowmode_lay = frac_used * TKE_lowmode_lay @@ -1287,7 +1294,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = (US%T_to_s**2 * TKE_to_Kd(i,k)) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = US%s_to_T * TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) @@ -1301,7 +1308,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, if (associated(dd%Kd_itidal)) then ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = (US%T_to_s**2 * TKE_to_Kd(i,k)) * TKE_itide_lay + Kd_add = US%s_to_T * 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 (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 (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 (k Date: Fri, 17 May 2019 10:36:42 -0400 Subject: [PATCH 062/106] Kd_interface diag unit fix Time scaling of Kd_interface diagnostic in the MOM diabatic driver was fixed to include its time scaling. A couple diffusive unit scalings were also replaced with diffusion macro. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 0e20d6883e..133d1c8645 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1513,9 +1513,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, & - scale=(US%Z_to_m**2)*US%s_to_T) + scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, & - scale=(US%Z_to_m**2)*US%s_to_T) + scale=US%Z2_T_to_m2_s) endif @@ -1587,9 +1587,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, & - scale=(US%Z_to_m**2)*US%s_to_T) + scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, & - scale=(US%Z_to_m**2)*US%s_to_T) + scale=US%Z2_T_to_m2_s) endif endif ! endif for KPP @@ -3086,7 +3086,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di !call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp) CS%id_Kd_interface = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & - 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2) + 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2) From 0435ff35be96b67a9eb38f3d53cf97d88b7c8393 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 17 May 2019 11:22:01 -0400 Subject: [PATCH 063/106] MOM_vert_friction tau[xy]_bot unit fix Bottom friction forces tau[xy]_bot are computed as Rho0 * u * a_u, and in this case a_u has been scaled to units of Z s-1, rather than m s-1, so the tau[xy]_bot diagnostic must be rescaled by Z_to_m. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4d32974bfa..2fbac7a551 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -162,9 +162,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock [Pa] + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock [Pa] + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave/Stokes information @@ -1769,9 +1769,11 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & - Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa') + Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & + conversion=US%Z_to_m) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & - Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa') + Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & + conversion=US%Z_to_m) 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 a23603246196f107780de4e4b0a4a550186b4c63 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 18 May 2019 10:08:19 -0400 Subject: [PATCH 064/106] +Removed hard newlines in get_param calls Removed hard newlines from numerous get_param and log_param descriptions throughout the MOM6 codebase, relying instead on the new automatic newline capability in writeMessageAndDesc. In the case of formatted lists of options, the hard newlines were retained. This cleans up the code and gives more standard messages and smaller parameter_doc files, but it changes the comments in every MOM_parameter_doc and SIS_parameter_doc file. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 96 ++++----- config_src/coupled_driver/ocean_model_MOM.F90 | 56 ++--- .../ice_solo_driver/MOM_surface_forcing.F90 | 92 ++++----- .../ice_solo_driver/ice_shelf_driver.F90 | 28 +-- .../ice_solo_driver/user_surface_forcing.F90 | 16 +- config_src/mct_driver/MOM_ocean_model.F90 | 38 ++-- config_src/mct_driver/MOM_surface_forcing.F90 | 78 +++---- config_src/mct_driver/ocn_comp_mct.F90 | 8 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 64 +++--- .../nuopc_driver/MOM_surface_forcing.F90 | 82 ++++---- .../solo_driver/MESO_surface_forcing.F90 | 26 +-- config_src/solo_driver/MOM_driver.F90 | 50 ++--- .../solo_driver/MOM_surface_forcing.F90 | 132 ++++++------ .../solo_driver/Neverland_surface_forcing.F90 | 16 +- .../solo_driver/user_surface_forcing.F90 | 16 +- src/ALE/MOM_ALE.F90 | 52 ++--- src/ALE/MOM_regridding.F90 | 54 ++--- src/core/MOM.F90 | 194 +++++++++--------- src/core/MOM_CoriolisAdv.F90 | 46 ++--- src/core/MOM_PressureForce.F90 | 10 +- src/core/MOM_PressureForce_Montgomery.F90 | 6 +- src/core/MOM_PressureForce_analytic_FV.F90 | 26 +-- src/core/MOM_PressureForce_blocked_AFV.F90 | 26 +-- src/core/MOM_barotropic.F90 | 160 +++++++-------- src/core/MOM_continuity.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 60 +++--- src/core/MOM_dynamics_split_RK2.F90 | 28 +-- src/core/MOM_dynamics_unsplit_RK2.F90 | 22 +- src/core/MOM_open_boundary.F90 | 90 ++++---- src/core/MOM_verticalGrid.F90 | 12 +- src/diagnostics/MOM_PointAccel.F90 | 10 +- src/diagnostics/MOM_debugging.F90 | 4 +- src/diagnostics/MOM_diag_to_Z.F90 | 6 +- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/diagnostics/MOM_obsolete_diagnostics.F90 | 4 +- src/diagnostics/MOM_sum_output.F90 | 36 ++-- src/equation_of_state/MOM_EOS.F90 | 34 +-- src/framework/MOM_diag_mediator.F90 | 16 +- src/framework/MOM_domains.F90 | 80 ++++---- src/framework/MOM_file_parser.F90 | 12 +- src/framework/MOM_restart.F90 | 10 +- src/framework/MOM_unit_scaling.F90 | 6 +- src/framework/MOM_write_cputime.F90 | 14 +- src/ice_shelf/MOM_ice_shelf.F90 | 80 ++++---- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 24 +-- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 12 +- src/ice_shelf/MOM_marine_ice.F90 | 7 +- src/ice_shelf/user_shelf_init.F90 | 6 +- .../MOM_coord_initialization.F90 | 26 +-- .../MOM_fixed_initialization.F90 | 2 +- src/initialization/MOM_grid_initialize.F90 | 34 +-- .../MOM_shared_initialization.F90 | 22 +- .../MOM_state_initialization.F90 | 107 +++++----- .../MOM_tracer_initialization_from_Z.F90 | 6 +- src/ocean_data_assim/MOM_oda_driver.F90 | 8 +- src/parameterizations/lateral/MOM_MEKE.F90 | 78 +++---- .../lateral/MOM_hor_visc.F90 | 96 ++++----- .../lateral/MOM_internal_tides.F90 | 58 +++--- .../lateral/MOM_lateral_mixing_coeffs.F90 | 90 ++++---- .../lateral/MOM_mixed_layer_restrat.F90 | 56 ++--- .../lateral/MOM_thickness_diffuse.F90 | 34 +-- .../lateral/MOM_tidal_forcing.F90 | 42 ++-- .../vertical/MOM_ALE_sponge.F90 | 24 +-- .../vertical/MOM_CVMix_KPP.F90 | 50 ++--- .../vertical/MOM_CVMix_conv.F90 | 12 +- .../vertical/MOM_CVMix_ddiff.F90 | 8 +- .../vertical/MOM_CVMix_shear.F90 | 16 +- .../vertical/MOM_bkgnd_mixing.F90 | 56 +++-- .../vertical/MOM_bulk_mixed_layer.F90 | 110 +++++----- .../vertical/MOM_diabatic_aux.F90 | 28 +-- .../vertical/MOM_diabatic_driver.F90 | 78 +++---- .../vertical/MOM_diapyc_energy_req.F90 | 6 +- .../vertical/MOM_energetic_PBL.F90 | 123 ++++++----- .../vertical/MOM_entrain_diffusive.F90 | 6 +- .../vertical/MOM_geothermal.F90 | 12 +- .../vertical/MOM_internal_tide_input.F90 | 12 +- .../vertical/MOM_kappa_shear.F90 | 66 +++--- .../vertical/MOM_opacity.F90 | 30 +-- .../vertical/MOM_regularize_layers.F90 | 19 +- .../vertical/MOM_set_diffusivity.F90 | 112 +++++----- .../vertical/MOM_set_viscosity.F90 | 116 +++++------ src/parameterizations/vertical/MOM_sponge.F90 | 4 +- .../vertical/MOM_tidal_mixing.F90 | 82 ++++---- .../vertical/MOM_vert_friction.F90 | 90 ++++---- src/tracer/DOME_tracer.F90 | 8 +- src/tracer/ISOMIP_tracer.F90 | 8 +- src/tracer/MOM_OCMIP2_CFC.F90 | 8 +- src/tracer/MOM_generic_tracer.F90 | 10 +- src/tracer/MOM_neutral_diffusion.F90 | 38 ++-- src/tracer/MOM_offline_main.F90 | 36 ++-- src/tracer/MOM_tracer_flow_control.F90 | 5 +- src/tracer/MOM_tracer_hor_diff.F90 | 32 +-- src/tracer/advection_test_tracer.F90 | 22 +- src/tracer/boundary_impulse_tracer.F90 | 10 +- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 6 +- src/tracer/ideal_age_example.F90 | 20 +- src/tracer/oil_tracer.F90 | 16 +- src/tracer/tracer_example.F90 | 8 +- src/user/BFB_surface_forcing.F90 | 16 +- src/user/DOME2d_initialization.F90 | 8 +- src/user/ISOMIP_initialization.F90 | 10 +- src/user/Idealized_Hurricane.F90 | 22 +- src/user/Kelvin_initialization.F90 | 4 +- src/user/MOM_controlled_forcing.F90 | 24 +-- src/user/MOM_wave_interface.F90 | 20 +- src/user/Phillips_initialization.F90 | 6 +- src/user/circle_obcs_initialization.F90 | 6 +- src/user/dumbbell_initialization.F90 | 4 +- src/user/dumbbell_surface_forcing.F90 | 16 +- src/user/dyed_channel_initialization.F90 | 2 +- src/user/dyed_obcs_initialization.F90 | 2 +- src/user/lock_exchange_initialization.F90 | 6 +- src/user/seamount_initialization.F90 | 8 +- src/user/shelfwave_initialization.F90 | 2 +- src/user/sloshing_initialization.F90 | 2 +- src/user/user_change_diffusivity.F90 | 24 +-- 117 files changed, 2036 insertions(+), 2045 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 2f806d778b..5112a0b64b 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1177,12 +1177,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & @@ -1190,64 +1190,64 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & - "The maximum surface pressure that can be exerted by the \n"//& - "atmosphere and floating sea-ice or ice shelves. This is \n"//& - "needed because the FMS coupling structure does not \n"//& - "limit the water that can be frozen out of the ocean and \n"//& - "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "The maximum surface pressure that can be exerted by the "//& + "atmosphere and floating sea-ice or ice shelves. This is "//& + "needed because the FMS coupling structure does not "//& + "limit the water that can be frozen out of the ocean and "//& + "the ice-ocean heat fluxes are treated explicitly. No "//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) call get_param(param_file, mdl, "RESTORE_SALINITY", CS%restore_salt, & - "If true, the coupled driver will add a globally-balanced \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& + "If true, the coupled driver will add a globally-balanced "//& + "fresh-water flux that drives sea-surface salinity "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE", CS%restore_temp, & - "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperature \n"//& + "If true, the coupled driver will add a "//& + "heat flux that drives sea-surface temperature "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & - "If true, adjusts the salinity restoring seen to zero\n"//& + "If true, adjusts the salinity restoring seen to zero "//& "whether restoring is via a salt flux or virtual precip.",& default=CS%restore_salt) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & - "If true, adjustments to salt restoring to achieve zero net are\n"//& + "If true, adjustments to salt restoring to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_TO_ZERO", & CS%adjust_net_fresh_water_to_zero, & - "If true, adjusts the net fresh-water forcing seen \n"//& + "If true, adjusts the net fresh-water forcing seen "//& "by the ocean (including restoring) to zero.", default=.false.) if (CS%adjust_net_fresh_water_to_zero) & call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & - "If true, use the wrong sign for the adjustment to\n"//& + "If true, use the wrong sign for the adjustment to "//& "the net fresh-water.", default=.true.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & - "If true, adjustments to net fresh water to achieve zero net are\n"//& + "If true, adjustments to net fresh water to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "The assumed sea-ice salinity needed to reverse engineer the "//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) call get_param(param_file, mdl, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & - "If true, return the sea surface height with the \n"//& - "correction for the atmospheric (and sea-ice) pressure \n"//& - "limited by max_p_surf instead of the full atmospheric \n"//& + "If true, return the sea surface height with the "//& + "correction for the atmospheric (and sea-ice) pressure "//& + "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) call get_param(param_file, mdl, "APPROX_NET_MASS_SRC", CS%approx_net_mass_src, & - "If true, use the net mass sources from the ice-ocean \n"//& - "boundary type without any further adjustments to drive \n"//& - "the ocean dynamics. The actual net mass source may differ \n"//& + "If true, use the net mass sources from the ice-ocean "//& + "boundary type without any further adjustments to drive "//& + "the ocean dynamics. The actual net mass source may differ "//& "due to internal corrections.", default=.false.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the input wind stress field. Valid \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& "values are 'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE @@ -1255,14 +1255,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& + "A factor multiplying the wind-stress given to the ocean by the "//& + "coupler. This is used for testing and should be =1.0 for any "//& "production runs.", default=1.0) if (CS%restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1276,19 +1276,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& + "If true, the restoring of salinity is applied as a salt "//& "flux instead of as a freshwater flux.", default=.false.) call get_param(param_file, mdl, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & "The maximum salinity difference used in restoring terms.", & units="PSU or g kg-1", default=999.0) call get_param(param_file, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & - "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "If true, disables SSS restoring under sea-ice based on a frazil "//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) call get_param(param_file, mdl, "MASK_SRESTORE_MARGINAL_SEAS", & CS%mask_srestore_marginal_seas, & - "If true, disable SSS restoring in marginal seas. Only used when\n"//& + "If true, disable SSS restoring in marginal seas. Only used when "//& "RESTORE_SALINITY is True.", default=.false.) call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & @@ -1303,14 +1303,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) enddo ; enddo endif call get_param(param_file, mdl, "MASK_SRESTORE", CS%mask_srestore, & - "If true, read a file (salt_restore_mask) containing \n"//& + "If true, read a file (salt_restore_mask) containing "//& "a mask for SSS restoring.", default=.false.) endif if (CS%restore_temp) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & @@ -1327,7 +1327,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "The maximum sst difference used in restoring terms.", & units="degC ", default=999.0) call get_param(param_file, mdl, "MASK_TRESTORE", CS%mask_trestore, & - "If true, read a file (temp_restore_mask) containing \n"//& + "If true, read a file (temp_restore_mask) containing "//& "a mask for SST restoring.", default=.false.) endif @@ -1340,11 +1340,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 @@ -1379,14 +1379,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) ! constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.") call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) @@ -1396,31 +1396,31 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & - "If true, sea-ice is rigid enough to exert a \n"//& + "If true, sea-ice is rigid enough to exert a "//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & - "A typical density of sea ice, used with the kinematic \n"//& + "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& + "The kinematic viscosity of sufficiently thick sea ice "//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & - "The mass of sea-ice per unit area at which the sea-ice \n"//& + "The mass of sea-ice per unit area at which the sea-ice "//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& + "If true, makes available diagnostics of fluxes from icebergs "//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& + "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index b62f479354..f9b84a97e1 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -278,41 +278,41 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, & - "If true, advance the state of MOM with a single step \n"//& - "including both dynamics and thermodynamics. If false, \n"//& + "If true, advance the state of MOM with a single step "//& + "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that \n"//& - "is actually used will be an integer fraction of the \n"//& + "The (baroclinic) dynamics time step. The time-step that "//& + "is actually used will be an integer fraction of the "//& "forcing time-step.", units="s", fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & - "The thermodynamic and tracer advection time step. \n"//& - "Ideally DT_THERM should be an integer multiple of DT \n"//& - "and less than the forcing or coupling time-step, unless \n"//& - "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& - "can be an integer multiple of the coupling timestep. By \n"//& + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& "default DT_THERM is set to DT.", units="s", default=OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & - "If true, the MOM will take thermodynamic and tracer \n"//& - "timesteps that can be longer than the coupling timestep. \n"//& - "The actual thermodynamic timestep that is used in this \n"//& - "case is the largest integer multiple of the coupling \n"//& + "If true, the MOM will take thermodynamic and tracer "//& + "timesteps that can be longer than the coupling timestep. "//& + "The actual thermodynamic timestep that is used in this "//& + "case is the largest integer multiple of the coupling "//& "timestep that is less than or equal to DT_THERM.", default=.false.) call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, & - "If true, apply diabatic and thermodynamic processes, \n"//& - "including buoyancy forcing and mass gain or loss, \n"//& + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& "before stepping the dynamics forward.", default=.false.) call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A restart file \n"//& - "will be saved at the end of the run segment for any \n"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A restart file "//& + "will be saved at the end of the run segment for any "//& "non-negative value.", default=1) call get_param(param_file, mdl, "OCEAN_SURFACE_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the surface velocity field that is \n"//& - "returned to the coupler. Valid values include \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the surface velocity field that is "//& + "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE @@ -321,9 +321,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "RHO_0", Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "G_EARTH", G_Earth, & @@ -341,9 +341,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) ! 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. call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "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.) if (HFrz .gt. 0.0) then diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index aec37b2a4a..77099b2595 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -976,7 +976,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! 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, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & "The directory in which all input files are found.", & @@ -984,33 +984,33 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ADIABATIC", CS%adiabatic, & - "There are no diapycnal mass fluxes if ADIABATIC is \n"//& - "true. This assumes that KD = KDML = 0.0 and that \n"//& - "there is no buoyancy forcing, but makes the model \n"//& + "There are no diapycnal mass fluxes if ADIABATIC is "//& + "true. This assumes that KD = KDML = 0.0 and that "//& + "there is no buoyancy forcing, but makes the model "//& "faster by eliminating subroutine calls.", default=.false.) call get_param(param_file, mdl, "VARIABLE_WINDS", CS%variable_winds, & "If true, the winds vary in time after the initialization.", & default=.true.) call get_param(param_file, mdl, "VARIABLE_BUOYFORCE", CS%variable_buoyforce, & - "If true, the buoyancy forcing varies in time after the \n"//& + "If true, the buoyancy forcing varies in time after the "//& "initialization of the model.", default=.true.) call get_param(param_file, mdl, "BUOY_CONFIG", CS%buoy_config, & - "The character string that indicates how buoyancy forcing \n"//& - "is specified. Valid options include (file), (zero), \n"//& + "The character string that indicates how buoyancy forcing "//& + "is specified. Valid options include (file), (zero), "//& "(linear), (USER), and (NONE).", fail_if_missing=.true.) if (trim(CS%buoy_config) == "file") then call get_param(param_file, mdl, "LONGWAVEDOWN_FILE", CS%longwavedown_file, & - "The file with the downward longwave heat flux, in \n"//& + "The file with the downward longwave heat flux, in "//& "variable lwdn_sfc.", fail_if_missing=.true.) call get_param(param_file, mdl, "LONGWAVEUP_FILE", CS%longwaveup_file, & - "The file with the upward longwave heat flux, in \n"//& + "The file with the upward longwave heat flux, in "//& "variable lwup_sfc.", fail_if_missing=.true.) call get_param(param_file, mdl, "EVAPORATION_FILE", CS%evaporation_file, & - "The file with the evaporative moisture flux, in \n"//& + "The file with the evaporative moisture flux, in "//& "variable evap.", fail_if_missing=.true.) call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & - "The file with the sensible heat flux, in \n"//& + "The file with the sensible heat flux, in "//& "variable shflx.", fail_if_missing=.true.) call get_param(param_file, mdl, "SHORTWAVEUP_FILE", CS%shortwaveup_file, & "The file with the upward shortwave heat flux.", & @@ -1019,28 +1019,28 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The file with the downward shortwave heat flux.", & fail_if_missing=.true.) call get_param(param_file, mdl, "SNOW_FILE", CS%snow_file, & - "The file with the downward frozen precip flux, in \n"//& + "The file with the downward frozen precip flux, in "//& "variable snow.", fail_if_missing=.true.) call get_param(param_file, mdl, "PRECIP_FILE", CS%precip_file, & - "The file with the downward total precip flux, in \n"//& + "The file with the downward total precip flux, in "//& "variable precip.", fail_if_missing=.true.) call get_param(param_file, mdl, "FRESHDISCHARGE_FILE", CS%freshdischarge_file, & - "The file with the fresh and frozen runoff/calving fluxes, \n"//& + "The file with the fresh and frozen runoff/calving fluxes, "//& "invariables disch_w and disch_s.", fail_if_missing=.true.) call get_param(param_file, mdl, "SSTRESTORE_FILE", CS%SSTrestore_file, & - "The file with the SST toward which to restore in \n"//& + "The file with the SST toward which to restore in "//& "variable TEMP.", fail_if_missing=.true.) call get_param(param_file, mdl, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & - "The file with the surface salinity toward which to \n"//& + "The file with the surface salinity toward which to "//& "restore in variable SALT.", fail_if_missing=.true.) endif call get_param(param_file, mdl, "WIND_CONFIG", CS%wind_config, & - "The character string that indicates how wind forcing \n"//& - "is specified. Valid options include (file), (2gyre), \n"//& + "The character string that indicates how wind forcing "//& + "is specified. Valid options include (file), (2gyre), "//& "(1gyre), (gyres), (zero), and (USER).", fail_if_missing=.true.) if (trim(CS%wind_config) == "file") then call get_param(param_file, mdl, "WIND_FILE", CS%wind_file, & - "The file in which the wind stresses are found in \n"//& + "The file in which the wind stresses are found in "//& "variables STRESS_X and STRESS_Y.", fail_if_missing=.true.) call get_param(param_file, mdl, "WINDSTRESS_X_VAR",CS%stress_x_var, & "The name of the x-wind stress variable in WIND_FILE.", & @@ -1049,7 +1049,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The name of the y-wind stress variable in WIND_FILE.", & default="STRESS_Y") call get_param(param_file, mdl, "WINDSTRESS_STAGGER",CS%wind_stagger, & - "A character indicating how the wind stress components \n"//& + "A character indicating how the wind stress components "//& "are staggered in WIND_FILE. This may be A or C for now.", & default="A") call get_param(param_file, mdl, "WINDSTRESS_SCALE", CS%wind_scale, & @@ -1058,66 +1058,66 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif if (trim(CS%wind_config) == "gyres") then call get_param(param_file, mdl, "TAUX_CONST", CS%gyres_taux_const, & - "With the gyres wind_config, the constant offset in the \n"//& - "zonal wind stress profile: \n"//& + "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, & - "With the gyres wind_config, the sine amplitude in the \n"//& - "zonal wind stress profile: \n"//& + "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, & - "With the gyres wind_config, the cosine amplitude in \n"//& - "the zonal wind stress profile: \n"//& + "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) call get_param(param_file, mdl, "TAUX_N_PIS",CS%gyres_taux_n_pis, & - "With the gyres wind_config, the number of gyres in \n"//& - "the zonal wind stress profile: \n"//& + "With the gyres wind_config, the number of gyres in "//& + "the zonal wind stress profile: "//& " n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="nondim", default=0.0) endif call get_param(param_file, mdl, "SOUTHLAT", CS%south_lat, & - "The southern latitude of the domain or the equivalent \n"//& + "The southern latitude of the domain or the equivalent "//& "starting value for the y-axis.", units=axis_units, default=0.) call get_param(param_file, mdl, "LENLAT", CS%len_lat, & "The latitudinal or y-direction length of the domain.", & units=axis_units, fail_if_missing=.true.) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 if (trim(CS%buoy_config) == "linear") then call get_param(param_file, mdl, "SST_NORTH", CS%T_north, & - "With buoy_config linear, the sea surface temperature \n"//& - "at the northern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface temperature "//& + "at the northern end of the domain toward which to "//& "to restore.", units="deg C", default=0.0) call get_param(param_file, mdl, "SST_SOUTH", CS%T_south, & - "With buoy_config linear, the sea surface temperature \n"//& - "at the southern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface temperature "//& + "at the southern end of the domain toward which to "//& "to restore.", units="deg C", default=0.0) call get_param(param_file, mdl, "SSS_NORTH", CS%S_north, & - "With buoy_config linear, the sea surface salinity \n"//& - "at the northern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface salinity "//& + "at the northern end of the domain toward which to "//& "to restore.", units="PSU", default=35.0) call get_param(param_file, mdl, "SSS_SOUTH", CS%S_south, & - "With buoy_config linear, the sea surface salinity \n"//& - "at the southern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface salinity "//& + "at the southern end of the domain toward which to "//& "to restore.", units="PSU", default=35.0) endif endif @@ -1129,11 +1129,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The background gustiness in the winds.", units="Pa", & default=0.02) call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) ; CS%gust(:,:) = 0.0 filename = trim(CS%inputdir) // trim(gust_file) diff --git a/config_src/ice_solo_driver/ice_shelf_driver.F90 b/config_src/ice_solo_driver/ice_shelf_driver.F90 index 7bfc7ec5ad..1d6f46427d 100644 --- a/config_src/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/ice_solo_driver/ice_shelf_driver.F90 @@ -209,14 +209,14 @@ program SHELF_main call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ICE_SHELF", use_ice_shelf, & - "If true, call the code to apply an ice shelf model over \n"//& + "If true, call the code to apply an ice shelf model over "//& "some of the domain.", default=.false.) if (.not.use_ice_shelf) call MOM_error(FATAL, & "shelf_driver: ICE_SHELF must be defined.") call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", time_step, & - "The time step for changing forcing, coupling with other \n"//& + "The time step for changing forcing, coupling with other "//& "components, or potentially writing certain diagnostics.", & units="s", fail_if_missing=.true.) @@ -250,16 +250,16 @@ program SHELF_main Time_end = increment_date(Time, years, months, days, hours, minutes, seconds) call MOM_mesg('Segment run length determied from ice_solo_nml.', 2) call get_param(param_file, mdl, "DAYMAX", daymax, & - "The final time of the whole simulation, in units of \n"//& - "TIMEUNIT seconds. This also sets the potential end \n"//& - "time of the present run segment if the end time is \n"//& + "The final time of the whole simulation, in units of "//& + "TIMEUNIT seconds. This also sets the potential end "//& + "time of the present run segment if the end time is "//& "not set (as it was here) via ocean_solo_nml in input.nml.", & timeunit=Time_unit, default=Time_end) else call get_param(param_file, mdl, "DAYMAX", daymax, & - "The final time of the whole simulation, in units of \n"//& - "TIMEUNIT seconds. This also sets the potential end \n"//& - "time of the present run segment if the end time is \n"//& + "The final time of the whole simulation, in units of "//& + "TIMEUNIT seconds. This also sets the potential end "//& + "time of the present run segment if the end time is "//& "not set via ocean_solo_nml in input.nml.", & timeunit=Time_unit, fail_if_missing=.true.) Time_end = daymax @@ -271,14 +271,14 @@ program SHELF_main "MOM_driver: The run has been started at or after the end time of the run.") call get_param(param_file, mdl, "RESTART_CONTROL", Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A non-time-stamped \n"//& - "restart file is saved at the end of the run segment \n"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A non-time-stamped "//& + "restart file is saved at the end of the run segment "//& "for any non-negative value.", default=1) call get_param(param_file, mdl, "RESTINT", restint, & - "The interval between saves of the restart file in units \n"//& - "of TIMEUNIT. Use 0 (the default) to not save \n"//& + "The interval between saves of the restart file in units "//& + "of TIMEUNIT. Use 0 (the default) to not save "//& "incremental restart files at all.", default=set_time(0), & timeunit=Time_unit) call log_param(param_file, mdl, "ELAPSED TIME AS MASTER", elapsed_time_master) diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 33c66a3c40..2d899ce1bb 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -306,16 +306,16 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, 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, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & @@ -323,13 +323,13 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) default=0.02) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 00645926a1..8bb3346021 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -286,15 +286,15 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A restart file \n"//& - "will be saved at the end of the run segment for any \n"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A restart file "//& + "will be saved at the end of the run segment for any "//& "non-negative value.", default=1) call get_param(param_file, mdl, "OCEAN_SURFACE_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the surface velocity field that is \n"//& - "returned to the coupler. Valid values include \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the surface velocity field that is "//& + "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then Ocean_sfc%stagger = AGRID @@ -308,17 +308,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i end if call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & - "If true, the coupled driver will add a globally-balanced \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& + "If true, the coupled driver will add a globally-balanced "//& + "fresh-water flux that drives sea-surface salinity "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & - "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperature \n"//& + "If true, the coupled driver will add a "//& + "heat flux that drives sea-surface temperature "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "G_EARTH", G_Earth, & @@ -339,8 +339,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & - "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& - "below berg are set to zero. Not applied for negative \n"//& + "Fraction of grid cell which iceberg must occupy, so that fluxes "//& + "below berg are set to zero. Not applied for negative "//& " values.", units="non-dim", default=-1.0) endif @@ -350,9 +350,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! vertical integrals, since the related 3-d sums are not negligible in cost. call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "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.) if (HFrz .gt. 0.0) then diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index fc9e7b7eeb..5b17cbbcff 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -1033,12 +1033,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & @@ -1046,46 +1046,46 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & - "The maximum surface pressure that can be exerted by the \n"//& - "atmosphere and floating sea-ice or ice shelves. This is \n"//& - "needed because the FMS coupling structure does not \n"//& - "limit the water that can be frozen out of the ocean and \n"//& - "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "The maximum surface pressure that can be exerted by the "//& + "atmosphere and floating sea-ice or ice shelves. This is "//& + "needed because the FMS coupling structure does not "//& + "limit the water that can be frozen out of the ocean and "//& + "the ice-ocean heat fluxes are treated explicitly. No "//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & - "If true, adjusts the salinity restoring seen to zero\n"//& + "If true, adjusts the salinity restoring seen to zero "//& "whether restoring is via a salt flux or virtual precip.",& default=restore_salt) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & - "If true, adjustments to salt restoring to achieve zero net are\n"//& + "If true, adjustments to salt restoring to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_TO_ZERO", & CS%adjust_net_fresh_water_to_zero, & - "If true, adjusts the net fresh-water forcing seen \n"//& + "If true, adjusts the net fresh-water forcing seen "//& "by the ocean (including restoring) to zero.", default=.false.) if (CS%adjust_net_fresh_water_to_zero) & call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & - "If true, use the wrong sign for the adjustment to\n"//& + "If true, use the wrong sign for the adjustment to "//& "the net fresh-water.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & - "If true, adjustments to net fresh water to achieve zero net are\n"//& + "If true, adjustments to net fresh water to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "The assumed sea-ice salinity needed to reverse engineer the "//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) call get_param(param_file, mdl, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & - "If true, return the sea surface height with the \n"//& - "correction for the atmospheric (and sea-ice) pressure \n"//& - "limited by max_p_surf instead of the full atmospheric \n"//& + "If true, return the sea surface height with the "//& + "correction for the atmospheric (and sea-ice) pressure "//& + "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) ! smg: should get_param call should be removed when have A=B code reconciled. @@ -1094,8 +1094,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=CS%use_temperature,do_not_log=.true.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the input wind stress field. Valid \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& "values are 'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE @@ -1103,14 +1103,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& + "A factor multiplying the wind-stress given to the ocean by the "//& + "coupler. This is used for testing and should be =1.0 for any "//& "production runs.", default=1.0) if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1124,19 +1124,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& + "If true, the restoring of salinity is applied as a salt "//& "flux instead of as a freshwater flux.", default=.false.) call get_param(param_file, mdl, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & "The maximum salinity difference used in restoring terms.", & units="PSU or g kg-1", default=999.0) call get_param(param_file, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & - "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "If true, disables SSS restoring under sea-ice based on a frazil "//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) call get_param(param_file, mdl, "MASK_SRESTORE_MARGINAL_SEAS", & CS%mask_srestore_marginal_seas, & - "If true, disable SSS restoring in marginal seas. Only used when\n"//& + "If true, disable SSS restoring in marginal seas. Only used when "//& "RESTORE_SALINITY is True.", default=.false.) call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & @@ -1154,8 +1154,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (restore_temp) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & @@ -1182,11 +1182,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 @@ -1221,14 +1221,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.") call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) @@ -1239,31 +1239,31 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & - "If true, sea-ice is rigid enough to exert a \n"//& + "If true, sea-ice is rigid enough to exert a "//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & - "A typical density of sea ice, used with the kinematic \n"//& + "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& + "The kinematic viscosity of sufficiently thick sea ice "//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & - "The mass of sea-ice per unit area at which the sea-ice \n"//& + "The mass of sea-ice per unit area at which the sea-ice "//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& + "If true, makes available diagnostics of fluxes from icebergs "//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& + "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) if (CS%allow_flux_adjustments) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5ce89fc9f7..5698335b6f 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -259,19 +259,19 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) if (glb%sw_decomp) then call get_param(param_file, mdl, "SW_c1", glb%c1, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "visible, direct shortwave.", units="nondim", default=0.285) call get_param(param_file, mdl, "SW_c2", glb%c2, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "visible, diffuse shortwave.", units="nondim", default=0.285) call get_param(param_file, mdl, "SW_c3", glb%c3, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "near-IR, direct shortwave.", units="nondim", default=0.215) call get_param(param_file, mdl, "SW_c4", glb%c4, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "near-IR, diffuse shortwave.", units="nondim", default=0.215) else glb%c1 = 0.0; glb%c2 = 0.0; glb%c3 = 0.0; glb%c4 = 0.0 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9f00994598..abe583ffcc 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -286,41 +286,41 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, & - "If true, advance the state of MOM with a single step \n"//& - "including both dynamics and thermodynamics. If false, \n"//& + "If true, advance the state of MOM with a single step "//& + "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that \n"//& - "is actually used will be an integer fraction of the \n"//& + "The (baroclinic) dynamics time step. The time-step that "//& + "is actually used will be an integer fraction of the "//& "forcing time-step.", units="s", fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & - "The thermodynamic and tracer advection time step. \n"//& - "Ideally DT_THERM should be an integer multiple of DT \n"//& - "and less than the forcing or coupling time-step, unless \n"//& - "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& - "can be an integer multiple of the coupling timestep. By \n"//& + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& "default DT_THERM is set to DT.", units="s", default=OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & - "If true, the MOM will take thermodynamic and tracer \n"//& - "timesteps that can be longer than the coupling timestep. \n"//& - "The actual thermodynamic timestep that is used in this \n"//& - "case is the largest integer multiple of the coupling \n"//& + "If true, the MOM will take thermodynamic and tracer "//& + "timesteps that can be longer than the coupling timestep. "//& + "The actual thermodynamic timestep that is used in this "//& + "case is the largest integer multiple of the coupling "//& "timestep that is less than or equal to DT_THERM.", default=.false.) call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, & - "If true, apply diabatic and thermodynamic processes, \n"//& - "including buoyancy forcing and mass gain or loss, \n"//& + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& "before stepping the dynamics forward.", default=.false.) call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A restart file \n"//& - "will be saved at the end of the run segment for any \n"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A restart file "//& + "will be saved at the end of the run segment for any "//& "non-negative value.", default=1) call get_param(param_file, mdl, "OCEAN_SURFACE_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the surface velocity field that is \n"//& - "returned to the coupler. Valid values include \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the surface velocity field that is "//& + "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE @@ -329,17 +329,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & - "If true, the coupled driver will add a globally-balanced \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& + "If true, the coupled driver will add a globally-balanced "//& + "fresh-water flux that drives sea-surface salinity "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & - "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperature \n"//& + "If true, the coupled driver will add a "//& + "heat flux that drives sea-surface temperature "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "G_EARTH", G_Earth, & @@ -355,9 +355,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "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.) if (HFrz .gt. 0.0) then diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 7bd705a07a..8348088b8a 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -1049,12 +1049,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & @@ -1062,51 +1062,51 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & - "The maximum surface pressure that can be exerted by the \n"//& - "atmosphere and floating sea-ice or ice shelves. This is \n"//& - "needed because the FMS coupling structure does not \n"//& - "limit the water that can be frozen out of the ocean and \n"//& - "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "The maximum surface pressure that can be exerted by the "//& + "atmosphere and floating sea-ice or ice shelves. This is "//& + "needed because the FMS coupling structure does not "//& + "limit the water that can be frozen out of the ocean and "//& + "the ice-ocean heat fluxes are treated explicitly. No "//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & - "If true, adjusts the salinity restoring seen to zero\n"//& + "If true, adjusts the salinity restoring seen to zero "//& "whether restoring is via a salt flux or virtual precip.",& default=restore_salt) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & - "If true, adjustments to salt restoring to achieve zero net are\n"//& + "If true, adjustments to salt restoring to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_TO_ZERO", & CS%adjust_net_fresh_water_to_zero, & - "If true, adjusts the net fresh-water forcing seen \n"//& + "If true, adjusts the net fresh-water forcing seen "//& "by the ocean (including restoring) to zero.", default=.false.) if (CS%adjust_net_fresh_water_to_zero) & call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & - "If true, use the wrong sign for the adjustment to\n"//& + "If true, use the wrong sign for the adjustment to "//& "the net fresh-water.", default=.true.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & - "If true, adjustments to net fresh water to achieve zero net are\n"//& + "If true, adjustments to net fresh water to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "The assumed sea-ice salinity needed to reverse engineer the "//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) call get_param(param_file, mdl, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & - "If true, return the sea surface height with the \n"//& - "correction for the atmospheric (and sea-ice) pressure \n"//& - "limited by max_p_surf instead of the full atmospheric \n"//& + "If true, return the sea surface height with the "//& + "correction for the atmospheric (and sea-ice) pressure "//& + "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the input wind stress field. Valid \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& "values are 'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE @@ -1114,14 +1114,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& + "A factor multiplying the wind-stress given to the ocean by the "//& + "coupler. This is used for testing and should be =1.0 for any "//& "production runs.", default=1.0) if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1135,19 +1135,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& + "If true, the restoring of salinity is applied as a salt "//& "flux instead of as a freshwater flux.", default=.false.) call get_param(param_file, mdl, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & "The maximum salinity difference used in restoring terms.", & units="PSU or g kg-1", default=999.0) call get_param(param_file, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & - "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "If true, disables SSS restoring under sea-ice based on a frazil "//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) call get_param(param_file, mdl, "MASK_SRESTORE_MARGINAL_SEAS", & CS%mask_srestore_marginal_seas, & - "If true, disable SSS restoring in marginal seas. Only used when\n"//& + "If true, disable SSS restoring in marginal seas. Only used when "//& "RESTORE_SALINITY is True.", default=.false.) call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & @@ -1162,14 +1162,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, enddo ; enddo endif call get_param(param_file, mdl, "MASK_SRESTORE", CS%mask_srestore, & - "If true, read a file (salt_restore_mask) containing \n"//& + "If true, read a file (salt_restore_mask) containing "//& "a mask for SSS restoring.", default=.false.) endif if (restore_temp) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & @@ -1186,7 +1186,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The maximum sst difference used in restoring terms.", & units="degC ", default=999.0) call get_param(param_file, mdl, "MASK_TRESTORE", CS%mask_trestore, & - "If true, read a file (temp_restore_mask) containing \n"//& + "If true, read a file (temp_restore_mask) containing "//& "a mask for SST restoring.", default=.false.) endif @@ -1199,11 +1199,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 @@ -1238,14 +1238,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.") call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) @@ -1255,31 +1255,31 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & - "If true, sea-ice is rigid enough to exert a \n"//& + "If true, sea-ice is rigid enough to exert a "//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & - "A typical density of sea ice, used with the kinematic \n"//& + "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& + "The kinematic viscosity of sufficiently thick sea ice "//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & - "The mass of sea-ice per unit area at which the sea-ice \n"//& + "The mass of sea-ice per unit area at which the sea-ice "//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& + "If true, makes available diagnostics of fluxes from icebergs "//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& + "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) if (CS%allow_flux_adjustments) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 28dc5305f1..1ce96fdac2 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -228,16 +228,16 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, 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, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & @@ -245,33 +245,33 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) default=0.02) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SSTRESTORE_FILE", CS%SSTrestore_file, & - "The file with the SST toward which to restore in \n"//& + "The file with the SST toward which to restore in "//& "variable TEMP.", fail_if_missing=.true.) call get_param(param_file, mdl, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & - "The file with the surface salinity toward which to \n"//& + "The file with the surface salinity toward which to "//& "restore in variable SALT.", fail_if_missing=.true.) call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%heating_file, & - "The file with the non-shortwave heat flux in \n"//& + "The file with the non-shortwave heat flux in "//& "variable Heat.", fail_if_missing=.true.) call get_param(param_file, mdl, "PRECIP_FILE", CS%PmE_file, & - "The file with the net precipiation minus evaporation \n"//& + "The file with the net precipiation minus evaporation "//& "in variable PmE.", fail_if_missing=.true.) call get_param(param_file, mdl, "SHORTWAVE_FILE", CS%Solar_file, & - "The file with the shortwave heat flux in \n"//& + "The file with the shortwave heat flux in "//& "variable NET_SOL.", fail_if_missing=.true.) call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 14890af0f8..22a216cb80 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -350,8 +350,8 @@ program MOM_main call log_version(param_file, mod_name, version, "") call get_param(param_file, mod_name, "DT", dt, fail_if_missing=.true.) call get_param(param_file, mod_name, "DT_FORCING", dt_forcing, & - "The time step for changing forcing, coupling with other \n"//& - "components, or potentially writing certain diagnostics. \n"//& + "The time step for changing forcing, coupling with other "//& + "components, or potentially writing certain diagnostics. "//& "The default value is given by DT.", units="s", default=dt) if (offline_tracer_mode) then call get_param(param_file, mod_name, "DT_OFFLINE", dt_forcing, & @@ -375,35 +375,35 @@ program MOM_main call get_param(param_file, mod_name, "DAYMAX", daymax, timeunit=Time_unit, & default=Time_end, do_not_log=.true.) call log_param(param_file, mod_name, "DAYMAX", daymax, & - "The final time of the whole simulation, in units of \n"//& - "TIMEUNIT seconds. This also sets the potential end \n"//& - "time of the present run segment if the end time is \n"//& + "The final time of the whole simulation, in units of "//& + "TIMEUNIT seconds. This also sets the potential end "//& + "time of the present run segment if the end time is "//& "not set via ocean_solo_nml in input.nml.", & timeunit=Time_unit) else call get_param(param_file, mod_name, "DAYMAX", daymax, & - "The final time of the whole simulation, in units of \n"//& - "TIMEUNIT seconds. This also sets the potential end \n"//& - "time of the present run segment if the end time is \n"//& + "The final time of the whole simulation, in units of "//& + "TIMEUNIT seconds. This also sets the potential end "//& + "time of the present run segment if the end time is "//& "not set via ocean_solo_nml in input.nml.", & timeunit=Time_unit, fail_if_missing=.true.) Time_end = daymax endif call get_param(param_file, mod_name, "SINGLE_STEPPING_CALL", single_step_call, & - "If true, advance the state of MOM with a single step \n"//& - "including both dynamics and thermodynamics. If false \n"//& + "If true, advance the state of MOM with a single step "//& + "including both dynamics and thermodynamics. If false "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mod_name, "DT_THERM", dt_therm, & - "The thermodynamic and tracer advection time step. \n"//& - "Ideally DT_THERM should be an integer multiple of DT \n"//& - "and less than the forcing or coupling time-step, unless \n"//& - "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& - "can be an integer multiple of the coupling timestep. By \n"//& + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& "default DT_THERM is set to DT.", units="s", default=dt) call get_param(param_file, mod_name, "DIABATIC_FIRST", diabatic_first, & - "If true, apply diabatic and thermodynamic processes, \n"//& - "including buoyancy forcing and mass gain or loss, \n"//& + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& "before stepping the dynamics forward.", default=.false.) @@ -411,19 +411,19 @@ program MOM_main "MOM_driver: The run has been started at or after the end time of the run.") call get_param(param_file, mod_name, "RESTART_CONTROL", Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A non-time-stamped \n"//& - "restart file is saved at the end of the run segment \n"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A non-time-stamped "//& + "restart file is saved at the end of the run segment "//& "for any non-negative value.", default=1) call get_param(param_file, mod_name, "RESTINT", restint, & - "The interval between saves of the restart file in units \n"//& - "of TIMEUNIT. Use 0 (the default) to not save \n"//& + "The interval between saves of the restart file in units "//& + "of TIMEUNIT. Use 0 (the default) to not save "//& "incremental restart files at all.", default=real_to_time(0.0), & timeunit=Time_unit) call get_param(param_file, mod_name, "WRITE_CPU_STEPS", cpu_steps, & - "The number of coupled timesteps between writing the cpu \n"//& - "time. If this is not positive, do not check cpu time, and \n"//& + "The number of coupled timesteps between writing the cpu "//& + "time. If this is not positive, do not check cpu time, and "//& "the segment run-length can not be set via an elapsed CPU time.", & default=1000) call get_param(param_file, "MOM", "DEBUG", debug, & diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 75a1ec321a..6fe06daea8 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -1392,7 +1392,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! 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, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & "The directory in which all input files are found.", & @@ -1400,39 +1400,39 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ADIABATIC", CS%adiabatic, & - "There are no diapycnal mass fluxes if ADIABATIC is \n"//& - "true. This assumes that KD = KDML = 0.0 and that \n"//& - "there is no buoyancy forcing, but makes the model \n"//& + "There are no diapycnal mass fluxes if ADIABATIC is "//& + "true. This assumes that KD = KDML = 0.0 and that "//& + "there is no buoyancy forcing, but makes the model "//& "faster by eliminating subroutine calls.", default=.false.) call get_param(param_file, mdl, "VARIABLE_WINDS", CS%variable_winds, & "If true, the winds vary in time after the initialization.", & default=.true.) call get_param(param_file, mdl, "VARIABLE_BUOYFORCE", CS%variable_buoyforce, & - "If true, the buoyancy forcing varies in time after the \n"//& + "If true, the buoyancy forcing varies in time after the "//& "initialization of the model.", default=.true.) call get_param(param_file, mdl, "BUOY_CONFIG", CS%buoy_config, & - "The character string that indicates how buoyancy forcing \n"//& - "is specified. Valid options include (file), (zero), \n"//& + "The character string that indicates how buoyancy forcing "//& + "is specified. Valid options include (file), (zero), "//& "(linear), (USER), (BFB) and (NONE).", fail_if_missing=.true.) if (trim(CS%buoy_config) == "file") then call get_param(param_file, mdl, "ARCHAIC_OMIP_FORCING_FILE", CS%archaic_OMIP_file, & - "If true, use the forcing variable decomposition from \n"//& - "the old German OMIP prescription that predated CORE. If \n"//& - "false, use the variable groupings available from MOM \n"//& + "If true, use the forcing variable decomposition from "//& + "the old German OMIP prescription that predated CORE. If "//& + "false, use the variable groupings available from MOM "//& "output diagnostics of forcing variables.", default=.true.) if (CS%archaic_OMIP_file) then call get_param(param_file, mdl, "LONGWAVEDOWN_FILE", CS%longwave_file, & - "The file with the downward longwave heat flux, in \n"//& + "The file with the downward longwave heat flux, in "//& "variable lwdn_sfc.", fail_if_missing=.true.) call get_param(param_file, mdl, "LONGWAVEUP_FILE", CS%longwaveup_file, & - "The file with the upward longwave heat flux, in \n"//& + "The file with the upward longwave heat flux, in "//& "variable lwup_sfc.", fail_if_missing=.true.) call get_param(param_file, mdl, "EVAPORATION_FILE", CS%evaporation_file, & - "The file with the evaporative moisture flux, in \n"//& + "The file with the evaporative moisture flux, in "//& "variable evap.", fail_if_missing=.true.) call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & - "The file with the sensible heat flux, in \n"//& + "The file with the sensible heat flux, in "//& "variable shflx.", fail_if_missing=.true.) call get_param(param_file, mdl, "SHORTWAVEUP_FILE", CS%shortwaveup_file, & "The file with the upward shortwave heat flux.", & @@ -1441,13 +1441,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The file with the downward shortwave heat flux.", & fail_if_missing=.true.) call get_param(param_file, mdl, "SNOW_FILE", CS%snow_file, & - "The file with the downward frozen precip flux, in \n"//& + "The file with the downward frozen precip flux, in "//& "variable snow.", fail_if_missing=.true.) call get_param(param_file, mdl, "PRECIP_FILE", CS%rain_file, & - "The file with the downward total precip flux, in \n"//& + "The file with the downward total precip flux, in "//& "variable precip.", fail_if_missing=.true.) call get_param(param_file, mdl, "FRESHDISCHARGE_FILE", CS%runoff_file, & - "The file with the fresh and frozen runoff/calving fluxes, \n"//& + "The file with the fresh and frozen runoff/calving fluxes, "//& "invariables disch_w and disch_s.", fail_if_missing=.true.) ! These variable names are hard-coded, per the archaic OMIP conventions. @@ -1458,52 +1458,52 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C else call get_param(param_file, mdl, "LONGWAVE_FILE", CS%longwave_file, & - "The file with the longwave heat flux, in the variable \n"//& + "The file with the longwave heat flux, in the variable "//& "given by LONGWAVE_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "LONGWAVE_FORCING_VAR", CS%LW_var, & "The variable with the longwave forcing field.", default="LW") call get_param(param_file, mdl, "SHORTWAVE_FILE", CS%shortwave_file, & - "The file with the shortwave heat flux, in the variable \n"//& + "The file with the shortwave heat flux, in the variable "//& "given by SHORTWAVE_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "SHORTWAVE_FORCING_VAR", CS%SW_var, & "The variable with the shortwave forcing field.", default="SW") call get_param(param_file, mdl, "EVAPORATION_FILE", CS%evaporation_file, & - "The file with the evaporative moisture flux, in the \n"//& + "The file with the evaporative moisture flux, in the "//& "variable given by EVAP_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "EVAP_FORCING_VAR", CS%evap_var, & "The variable with the evaporative moisture flux.", & default="evap") call get_param(param_file, mdl, "LATENTHEAT_FILE", CS%latentheat_file, & - "The file with the latent heat flux, in the variable \n"//& + "The file with the latent heat flux, in the variable "//& "given by LATENT_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "LATENT_FORCING_VAR", CS%latent_var, & "The variable with the latent heat flux.", default="latent") call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & - "The file with the sensible heat flux, in the variable \n"//& + "The file with the sensible heat flux, in the variable "//& "given by SENSIBLE_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "SENSIBLE_FORCING_VAR", CS%sens_var, & "The variable with the sensible heat flux.", default="sensible") call get_param(param_file, mdl, "RAIN_FILE", CS%rain_file, & - "The file with the liquid precipitation flux, in the \n"//& + "The file with the liquid precipitation flux, in the "//& "variable given by RAIN_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "RAIN_FORCING_VAR", CS%rain_var, & "The variable with the liquid precipitation flux.", & default="liq_precip") call get_param(param_file, mdl, "SNOW_FILE", CS%snow_file, & - "The file with the frozen precipitation flux, in the \n"//& + "The file with the frozen precipitation flux, in the "//& "variable given by SNOW_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "SNOW_FORCING_VAR", CS%snow_var, & "The variable with the frozen precipitation flux.", & default="froz_precip") call get_param(param_file, mdl, "RUNOFF_FILE", CS%runoff_file, & - "The file with the fresh and frozen runoff/calving \n"//& - "fluxes, in variables given by LIQ_RUNOFF_FORCING_VAR \n"//& + "The file with the fresh and frozen runoff/calving "//& + "fluxes, in variables given by LIQ_RUNOFF_FORCING_VAR "//& "and FROZ_RUNOFF_FORCING_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "LIQ_RUNOFF_FORCING_VAR", CS%lrunoff_var, & "The variable with the liquid runoff flux.", & @@ -1514,10 +1514,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif call get_param(param_file, mdl, "SSTRESTORE_FILE", CS%SSTrestore_file, & - "The file with the SST toward which to restore in the \n"//& + "The file with the SST toward which to restore in the "//& "variable given by SST_RESTORE_VAR.", fail_if_missing=.true.) call get_param(param_file, mdl, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & - "The file with the surface salinity toward which to \n"//& + "The file with the surface salinity toward which to "//& "restore in the variable given by SSS_RESTORE_VAR.", & fail_if_missing=.true.) @@ -1549,17 +1549,17 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%salinityrestore_file = trim(CS%inputdir)//trim(CS%salinityrestore_file) elseif (trim(CS%buoy_config) == "const") then call get_param(param_file, mdl, "SENSIBLE_HEAT_FLUX", CS%constantHeatForcing, & - "A constant heat forcing (positive into ocean) applied \n"//& + "A constant heat forcing (positive into ocean) applied "//& "through the sensible heat flux field. ", & units='W/m2', fail_if_missing=.true.) endif call get_param(param_file, mdl, "WIND_CONFIG", CS%wind_config, & - "The character string that indicates how wind forcing \n"//& - "is specified. Valid options include (file), (2gyre), \n"//& + "The character string that indicates how wind forcing "//& + "is specified. Valid options include (file), (2gyre), "//& "(1gyre), (gyres), (zero), and (USER).", fail_if_missing=.true.) if (trim(CS%wind_config) == "file") then call get_param(param_file, mdl, "WIND_FILE", CS%wind_file, & - "The file in which the wind stresses are found in \n"//& + "The file in which the wind stresses are found in "//& "variables STRESS_X and STRESS_Y.", fail_if_missing=.true.) call get_param(param_file, mdl, "WINDSTRESS_X_VAR",CS%stress_x_var, & "The name of the x-wind stress variable in WIND_FILE.", & @@ -1568,37 +1568,37 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The name of the y-wind stress variable in WIND_FILE.", & default="STRESS_Y") call get_param(param_file, mdl, "WINDSTRESS_STAGGER",CS%wind_stagger, & - "A character indicating how the wind stress components \n"//& + "A character indicating how the wind stress components "//& "are staggered in WIND_FILE. This may be A or C for now.", & default="A") call get_param(param_file, mdl, "WINDSTRESS_SCALE", CS%wind_scale, & "A value by which the wind stresses in WIND_FILE are rescaled.", & default=1.0, units="nondim") call get_param(param_file, mdl, "USTAR_FORCING_VAR", CS%ustar_var, & - "The name of the friction velocity variable in WIND_FILE \n"//& - "or blank to get ustar from the wind stresses plus the \n"//& + "The name of the friction velocity variable in WIND_FILE "//& + "or blank to get ustar from the wind stresses plus the "//& "gustiness.", default=" ", units="nondim") CS%wind_file = trim(CS%inputdir) // trim(CS%wind_file) endif if (trim(CS%wind_config) == "gyres") then call get_param(param_file, mdl, "TAUX_CONST", CS%gyres_taux_const, & - "With the gyres wind_config, the constant offset in the \n"//& - "zonal wind stress profile: \n"//& + "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, & - "With the gyres wind_config, the sine amplitude in the \n"//& - "zonal wind stress profile: \n"//& + "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, & - "With the gyres wind_config, the cosine amplitude in \n"//& - "the zonal wind stress profile: \n"//& + "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) call get_param(param_file, mdl, "TAUX_N_PIS",CS%gyres_taux_n_pis, & - "With the gyres wind_config, the number of gyres in \n"//& - "the zonal wind stress profile: \n"//& + "With the gyres wind_config, the number of gyres in "//& + "the zonal wind stress profile: "//& " n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="nondim", default=0.0) endif @@ -1610,14 +1610,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%len_lat = G%len_lat endif call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) @@ -1625,20 +1625,20 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The latent heat of fusion.", units="J/kg", default=hlv) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) if (CS%use_temperature) then call get_param(param_file, mdl, "FLUXCONST_T", CS%Flux_const_T, & - "The constant that relates the restoring surface temperature\n"//& - "flux to the relative surface anomaly (akin to a piston \n"//& + "The constant that relates the restoring surface temperature "//& + "flux to the relative surface anomaly (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & default=CS%Flux_const) call get_param(param_file, mdl, "FLUXCONST_S", CS%Flux_const_S, & - "The constant that relates the restoring surface salinity\n"//& - "flux to the relative surface anomaly (akin to a piston \n"//& + "The constant that relates the restoring surface salinity "//& + "flux to the relative surface anomaly (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & default=CS%Flux_const) endif @@ -1650,20 +1650,20 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C if (trim(CS%buoy_config) == "linear") then call get_param(param_file, mdl, "SST_NORTH", CS%T_north, & - "With buoy_config linear, the sea surface temperature \n"//& - "at the northern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface temperature "//& + "at the northern end of the domain toward which to "//& "to restore.", units="deg C", default=0.0) call get_param(param_file, mdl, "SST_SOUTH", CS%T_south, & - "With buoy_config linear, the sea surface temperature \n"//& - "at the southern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface temperature "//& + "at the southern end of the domain toward which to "//& "to restore.", units="deg C", default=0.0) call get_param(param_file, mdl, "SSS_NORTH", CS%S_north, & - "With buoy_config linear, the sea surface salinity \n"//& - "at the northern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface salinity "//& + "at the northern end of the domain toward which to "//& "to restore.", units="PSU", default=35.0) call get_param(param_file, mdl, "SSS_SOUTH", CS%S_south, & - "With buoy_config linear, the sea surface salinity \n"//& - "at the southern end of the domain toward which to \n"//& + "With buoy_config linear, the sea surface salinity "//& + "at the southern end of the domain toward which to "//& "to restore.", units="PSU", default=35.0) endif endif @@ -1675,11 +1675,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The background gustiness in the winds.", units="Pa", & default=0.02) call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) filename = trim(CS%inputdir) // trim(gust_file) @@ -1704,10 +1704,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call idealized_hurricane_wind_init(Time, G, 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\n"//& + "With wind_config const, this is the constant zonal "//& "wind-stress", units="Pa", 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\n"//& + "With wind_config const, this is the constant meridional "//& "wind-stress", units="Pa", fail_if_missing=.true.) elseif (trim(CS%wind_config) == "SCM_CVmix_tests" .or. & trim(CS%buoy_config) == "SCM_CVmix_tests") then diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 94726a62c3..71e91a539c 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -233,16 +233,16 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, 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, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) ! call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & @@ -250,14 +250,14 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) ! default=0.02) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) ! Convert CS%flux_const from m day-1 to m s-1. diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index a9787b9348..5ff39ae8c4 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -256,16 +256,16 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, 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, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & @@ -273,13 +273,13 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) default=0.02) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 6793c73be2..b9aedb7a1c 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -161,8 +161,8 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) call get_param(param_file, mdl, "REMAP_UV_USING_OLD_ALG", & CS%remap_uv_using_old_alg, & - "If true, uses the old remapping-via-a-delta-z method for\n"//& - "remapping u and v. If false, uses the new method that remaps\n"//& + "If true, uses the old remapping-via-a-delta-z method for "//& + "remapping u and v. If false, uses the new method that remaps "//& "between grids described by an old and new thickness.", & default=.true.) @@ -171,24 +171,24 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) ! Initialize and configure remapping call get_param(param_file, mdl, "REMAPPING_SCHEME", string, & - "This sets the reconstruction scheme used\n"//& - "for vertical remapping for all variables.\n"//& - "It can be one of the following schemes:\n"//& + "This sets the reconstruction scheme used "//& + "for vertical remapping for all variables. "//& + "It can be one of the following schemes: "//& trim(remappingSchemesDoc), default=remappingDefaultScheme) call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & - "If true, cell-by-cell reconstructions are checked for\n"//& - "consistency and if non-monotonicity or an inconsistency is\n"//& + "If true, cell-by-cell reconstructions are checked for "//& + "consistency and if non-monotonicity or an inconsistency is "//& "detected then a FATAL error is issued.", default=.false.) call get_param(param_file, mdl, "FATAL_CHECK_REMAPPING", check_remapping, & - "If true, the results of remapping are checked for\n"//& - "conservation and new extrema and if an inconsistency is\n"//& + "If true, the results of remapping are checked for "//& + "conservation and new extrema and if an inconsistency is "//& "detected then a FATAL error is issued.", default=.false.) call get_param(param_file, mdl, "REMAP_BOUND_INTERMEDIATE_VALUES", force_bounds_in_subcell, & - "If true, the values on the intermediate grid used for remapping\n"//& - "are forced to be bounded, which might not be the case due to\n"//& + "If true, the values on the intermediate grid used for remapping "//& + "are forced to be bounded, which might not be the case due to "//& "round off.", default=.false.) call get_param(param_file, mdl, "REMAP_BOUNDARY_EXTRAP", remap_boundary_extrap, & - "If true, values at the interfaces of boundary cells are \n"//& + "If true, values at the interfaces of boundary cells are "//& "extrapolated instead of piecewise constant", default=.false.) call initialize_remapping( CS%remapCS, string, & boundary_extrapolation=remap_boundary_extrap, & @@ -197,32 +197,32 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) force_bounds_in_subcell=force_bounds_in_subcell) call get_param(param_file, mdl, "REMAP_AFTER_INITIALIZATION", CS%remap_after_initialization, & - "If true, applies regridding and remapping immediately after\n"//& - "initialization so that the state is ALE consistent. This is a\n"//& - "legacy step and should not be needed if the initialization is\n"//& + "If true, applies regridding and remapping immediately after "//& + "initialization so that the state is ALE consistent. This is a "//& + "legacy step and should not be needed if the initialization is "//& "consistent with the coordinate mode.", default=.true.) call get_param(param_file, mdl, "REGRID_TIME_SCALE", CS%regrid_time_scale, & - "The time-scale used in blending between the current (old) grid\n"//& - "and the target (new) grid. A short time-scale favors the target\n"//& - "grid (0. or anything less than DT_THERM) has no memory of the old\n"//& + "The time-scale used in blending between the current (old) grid "//& + "and the target (new) grid. A short time-scale favors the target "//& + "grid (0. or anything less than DT_THERM) has no memory of the old "//& "grid. A very long time-scale makes the model more Lagrangian.", & units="s", default=0.) call get_param(param_file, mdl, "REGRID_FILTER_SHALLOW_DEPTH", filter_shallow_depth, & - "The depth above which no time-filtering is applied. Above this depth\n"//& + "The depth above which no time-filtering is applied. Above this depth "//& "final grid exactly matches the target (new) grid.", & units="m", default=0., scale=GV%m_to_H) call get_param(param_file, mdl, "REGRID_FILTER_DEEP_DEPTH", filter_deep_depth, & - "The depth below which full time-filtering is applied with time-scale\n"//& - "REGRID_TIME_SCALE. Between depths REGRID_FILTER_SHALLOW_DEPTH and\n"//& + "The depth below which full time-filtering is applied with time-scale "//& + "REGRID_TIME_SCALE. Between depths REGRID_FILTER_SHALLOW_DEPTH and "//& "REGRID_FILTER_SHALLOW_DEPTH the filter weights adopt a cubic profile.", & units="m", default=0., scale=GV%m_to_H) call set_regrid_params(CS%regridCS, depth_of_time_filter_shallow=filter_shallow_depth, & depth_of_time_filter_deep=filter_deep_depth) call get_param(param_file, mdl, "REGRID_USE_OLD_DIRECTION", local_logical, & - "If true, the regridding ntegrates upwards from the bottom for\n"//& - "interface positions, much as the main model does. If false\n"//& - "regridding integrates downward, consistant with the remapping\n"//& + "If true, the regridding ntegrates upwards from the bottom for "//& + "interface positions, much as the main model does. If false "//& + "regridding integrates downward, consistant with the remapping "//& "code.", default=.true., do_not_log=.true.) call set_regrid_params(CS%regridCS, integrate_downward_for_e=.not.local_logical) @@ -1121,8 +1121,8 @@ subroutine ALE_initRegridding(GV, US, max_depth, param_file, mdl, regridCS) character(len=30) :: coord_mode call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", coord_mode, & - "Coordinate mode for vertical regridding.\n"//& - "Choose among the following possibilities:\n"//& + "Coordinate mode for vertical regridding. "//& + "Choose among the following possibilities: "//& trim(regriddingCoordinateModeDoc), & default=DEFAULT_COORDINATE_MODE, fail_if_missing=.true.) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 4dd05fd388..bb171aba7a 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -244,21 +244,21 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m string2 = 'PPM_H4' ! Default for diagnostics endif call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, & - "This sets the interpolation scheme to use to\n"//& - "determine the new grid. These parameters are\n"//& - "only relevant when REGRIDDING_COORDINATE_MODE is\n"//& - "set to a function of state. Otherwise, it is not\n"//& - "used. It can be one of the following schemes:\n"//& + "This sets the interpolation scheme to use to "//& + "determine the new grid. These parameters are "//& + "only relevant when REGRIDDING_COORDINATE_MODE is "//& + "set to a function of state. Otherwise, it is not "//& + "used. It can be one of the following schemes: "//& trim(regriddingInterpSchemeDoc), default=trim(string2)) call set_regrid_params(CS, interp_scheme=string) endif if (main_parameters .and. coord_is_state_dependent) then call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", tmpLogical, & - "When defined, a proper high-order reconstruction\n"//& - "scheme is used within boundary cells rather\n"//& - "than PCM. E.g., if PPM is used for remapping, a\n"//& - "PPM reconstruction will also be used within\n"//& + "When defined, a proper high-order reconstruction "//& + "scheme is used within boundary cells rather "//& + "than PCM. E.g., if PPM is used for remapping, a "//& + "PPM reconstruction will also be used within "//& "boundary cells.", default=regriddingDefaultBoundaryExtrapolation) call set_regrid_params(CS, boundary_extrapolation=tmpLogical) else @@ -277,7 +277,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (maximum_depth>3000.) string2='WOA09' ! For convenience endif call get_param(param_file, mdl, param_name, string, & - "Determines how to specify the coordinate\n"//& + "Determines how to specify the coordinate "//& "resolution. Valid options are:\n"//& " PARAM - use the vector-parameter "//trim(coord_res_param)//"\n"//& " UNIFORM[:N] - uniformly distributed\n"//& @@ -501,15 +501,15 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (main_parameters .and. coord_is_state_dependent) then call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & - "When interpolating potential density profiles we can add\n"//& - "some artificial compressibility solely to make homogeneous\n"//& + "When interpolating potential density profiles we can add "//& + "some artificial compressibility solely to make homogeneous "//& "regions appear stratified.", default=0.) call set_regrid_params(CS, compress_fraction=tmpReal) endif if (main_parameters) then call get_param(param_file, mdl, "MIN_THICKNESS", tmpReal, & - "When regridding, this is the minimum layer\n"//& + "When regridding, this is the minimum layer "//& "thickness allowed.", units="m", scale=GV%m_to_H, & default=regriddingDefaultMinThickness ) call set_regrid_params(CS, min_thickness=tmpReal) @@ -520,23 +520,23 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (coordinateMode(coord_mode) == REGRIDDING_SLIGHT) then ! Set SLight-specific regridding parameters. call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & - "The nominal thickness of fixed thickness near-surface\n"//& + "The nominal thickness of fixed thickness near-surface "//& "layers with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & - "The number of fixed-depth surface layers with the SLight\n"//& + "The number of fixed-depth surface layers with the SLight "//& "coordinate.", units="nondimensional", default=2) call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & - "The thickness of the surface region over which to average\n"//& - "when calculating the density to use to define the interior\n"//& + "The thickness of the surface region over which to average "//& + "when calculating the density to use to define the interior "//& "with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & - "The number of layers to offset the surface density when\n"//& + "The number of layers to offset the surface density when "//& "defining where the interior ocean starts with SLight.", & units="nondimensional", default=2.0) call get_param(param_file, mdl, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & - "If true, identify regions above the reference pressure\n"//& - "where the reference pressure systematically underestimates\n"//& - "the stratification and use this in the definition of the\n"//& + "If true, identify regions above the reference pressure "//& + "where the reference pressure systematically underestimates "//& + "the stratification and use this in the definition of the "//& "interior with the SLight coordinate.", default=.false.) call set_regrid_params(CS, dz_min_surface=dz_fixed_sfc, & @@ -545,14 +545,14 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (fix_haloclines) then ! Set additional parameters related to SLIGHT_FIX_HALOCLINES. call get_param(param_file, mdl, "HALOCLINE_FILTER_LENGTH", filt_len, & - "A length scale over which to smooth the temperature and\n"//& + "A length scale over which to smooth the temperature and "//& "salinity before identifying erroneously unstable haloclines.", & units="m", default=2.0) call get_param(param_file, mdl, "HALOCLINE_STRAT_TOL", strat_tol, & - "A tolerance for the ratio of the stratification of the\n"//& - "apparent coordinate stratification to the actual value\n"//& - "that is used to identify erroneously unstable haloclines.\n"//& - "This ratio is 1 when they are equal, and sensible values \n"//& + "A tolerance for the ratio of the stratification of the "//& + "apparent coordinate stratification to the actual value "//& + "that is used to identify erroneously unstable haloclines. "//& + "This ratio is 1 when they are equal, and sensible values "//& "are between 0 and 0.5.", units="nondimensional", default=0.2) call set_regrid_params(CS, halocline_filt_len=filt_len, & halocline_strat_tol=strat_tol) @@ -575,7 +575,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m "Scaling on optimization tendency.", & units="nondim", default=1.0) call get_param(param_file, mdl, "ADAPT_DO_MIN_DEPTH", tmpLogical, & - "If true, make a HyCOM-like mixed layer by preventing interfaces\n"//& + "If true, make a HyCOM-like mixed layer by preventing interfaces "//& "from being shallower than the depths specified by the regridding coordinate.", & default=.false.) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4762e9f26d..64e6044772 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1662,86 +1662,86 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call get_param(param_file, "MOM", "CALC_RHO_FOR_SEA_LEVEL", CS%calc_rho_for_sea_lev, & - "If true, the in-situ density is used to calculate the\n"//& - "effective sea level that is returned to the coupler. If false,\n"//& + "If true, the in-situ density is used to calculate the "//& + "effective sea level that is returned to the coupler. If false, "//& "the Boussinesq parameter RHO_0 is used.", default=.false.) call get_param(param_file, "MOM", "ENABLE_THERMODYNAMICS", use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, "MOM", "USE_EOS", use_EOS, & - "If true, density is calculated from temperature and \n"//& - "salinity with an equation of state. If USE_EOS is \n"//& + "If true, density is calculated from temperature and "//& + "salinity with an equation of state. If USE_EOS is "//& "true, ENABLE_THERMODYNAMICS must be true as well.", & default=use_temperature) call get_param(param_file, "MOM", "DIABATIC_FIRST", CS%diabatic_first, & - "If true, apply diabatic and thermodynamic processes, \n"//& - "including buoyancy forcing and mass gain or loss, \n"//& + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& "before stepping the dynamics forward.", default=.false.) call get_param(param_file, "MOM", "USE_CONTEMP_ABSSAL", use_conT_absS, & - "If true, the prognostics T&S are the conservative temperature \n"//& - "and absolute salinity. Care should be taken to convert them \n"//& - "to potential temperature and practical salinity before \n"//& - "exchanging them with the coupler and/or reporting T&S diagnostics.\n", & + "If true, the prognostics T&S are the conservative temperature "//& + "and absolute salinity. Care should be taken to convert them "//& + "to potential temperature and practical salinity before "//& + "exchanging them with the coupler and/or reporting T&S diagnostics.", & default=.false.) CS%tv%T_is_conT = use_conT_absS ; CS%tv%S_is_absS = use_conT_absS call get_param(param_file, "MOM", "ADIABATIC", CS%adiabatic, & - "There are no diapycnal mass fluxes if ADIABATIC is \n"//& - "true. This assumes that KD = KDML = 0.0 and that \n"//& - "there is no buoyancy forcing, but makes the model \n"//& + "There are no diapycnal mass fluxes if ADIABATIC is "//& + "true. This assumes that KD = KDML = 0.0 and that "//& + "there is no buoyancy forcing, but makes the model "//& "faster by eliminating subroutine calls.", default=.false.) call get_param(param_file, "MOM", "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic_driver, & - "If true, use a legacy version of the diabatic subroutine. \n"//& + "If true, use a legacy version of the diabatic subroutine. "//& "This is temporary and is needed to avoid change in answers.", & default=.true.) call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, & - "If False, skips the dynamics calls that update u & v, as well as \n"//& - "the gravity wave adjustment to h. This is a fragile feature and \n"//& + "If False, skips the dynamics calls that update u & v, as well as "//& + "the gravity wave adjustment to h. This is a fragile feature and "//& "thus undocumented.", default=.true., do_not_log=.true. ) call get_param(param_file, "MOM", "ADVECT_TS", advect_TS, & - "If True, advect temperature and salinity horizontally \n"//& - "If False, T/S are registered for advection.\n"//& - "This is intended only to be used in offline tracer mode \n"//& + "If True, advect temperature and salinity horizontally "//& + "If False, T/S are registered for advection. "//& + "This is intended only to be used in offline tracer mode "//& "and is by default false in that case.", & do_not_log = .true., default=.true. ) if (present(offline_tracer_mode)) then ! Only read this parameter in enabled modes call get_param(param_file, "MOM", "OFFLINE_TRACER_MODE", CS%offline_tracer_mode, & - "If true, barotropic and baroclinic dynamics, thermodynamics\n"//& - "are all bypassed with all the fields necessary to integrate\n"//& - "the tracer advection and diffusion equation are read in from\n"//& - "files stored from a previous integration of the prognostic model.\n"//& + "If true, barotropic and baroclinic dynamics, thermodynamics "//& + "are all bypassed with all the fields necessary to integrate "//& + "the tracer advection and diffusion equation are read in from "//& + "files stored from a previous integration of the prognostic model. "//& "NOTE: This option only used in the ocean_solo_driver.", default=.false.) if (CS%offline_tracer_mode) then call get_param(param_file, "MOM", "ADVECT_TS", advect_TS, & - "If True, advect temperature and salinity horizontally\n"//& - "If False, T/S are registered for advection.\n"//& + "If True, advect temperature and salinity horizontally "//& + "If False, T/S are registered for advection. "//& "This is intended only to be used in offline tracer mode."//& "and is by default false in that case", & default=.false. ) endif endif call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm, & - "If True, use the ALE algorithm (regridding/remapping).\n"//& + "If True, use the ALE algorithm (regridding/remapping). "//& "If False, use the layered isopycnal algorithm.", default=.false. ) call get_param(param_file, "MOM", "BULKMIXEDLAYER", bulkmixedlayer, & - "If true, use a Kraus-Turner-like bulk mixed layer \n"//& - "with transitional buffer layers. Layers 1 through \n"//& - "NKML+NKBL have variable densities. There must be at \n"//& - "least NKML+NKBL+1 layers if BULKMIXEDLAYER is true. \n"//& - "BULKMIXEDLAYER can not be used with USE_REGRIDDING. \n"//& + "If true, use a Kraus-Turner-like bulk mixed layer "//& + "with transitional buffer layers. Layers 1 through "//& + "NKML+NKBL have variable densities. There must be at "//& + "least NKML+NKBL+1 layers if BULKMIXEDLAYER is true. "//& + "BULKMIXEDLAYER can not be used with USE_REGRIDDING. "//& "The default is influenced by ENABLE_THERMODYNAMICS.", & default=use_temperature .and. .not.CS%use_ALE_algorithm) call get_param(param_file, "MOM", "THICKNESSDIFFUSE", CS%thickness_diffuse, & - "If true, interface heights are diffused with a \n"//& + "If true, interface heights are diffused with a "//& "coefficient of KHTH.", default=.false.) call get_param(param_file, "MOM", "THICKNESSDIFFUSE_FIRST", & CS%thickness_diffuse_first, & - "If true, do thickness diffusion before dynamics.\n"//& + "If true, do thickness diffusion before dynamics. "//& "This is only used if THICKNESSDIFFUSE is true.", & default=.false.) if (.not.CS%thickness_diffuse) CS%thickness_diffuse_first = .false. call get_param(param_file, "MOM", "BATHYMETRY_AT_VEL", bathy_at_vel, & - "If true, there are separate values for the basin depths \n"//& - "at velocity points. Otherwise the effects of topography \n"//& + "If true, there are separate values for the basin depths "//& + "at velocity points. Otherwise the effects of topography "//& "are entirely determined from thickness points.", & default=.false.) call get_param(param_file, "MOM", "USE_WAVES", CS%UseWaves, default=.false., & @@ -1751,56 +1751,56 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) call get_param(param_file, "MOM", "DEBUG_TRUNCATIONS", debug_truncations, & - "If true, calculate all diagnostics that are useful for \n"//& + "If true, calculate all diagnostics that are useful for "//& "debugging truncations.", default=.false., debuggingParam=.true.) call get_param(param_file, "MOM", "DT", CS%dt, & - "The (baroclinic) dynamics time step. The time-step that \n"//& - "is actually used will be an integer fraction of the \n"//& - "forcing time-step (DT_FORCING in ocean-only mode or the \n"//& + "The (baroclinic) dynamics time step. The time-step that "//& + "is actually used will be an integer fraction of the "//& + "forcing time-step (DT_FORCING in ocean-only mode or the "//& "coupling timestep in coupled mode.)", units="s", & fail_if_missing=.true.) call get_param(param_file, "MOM", "DT_THERM", CS%dt_therm, & - "The thermodynamic and tracer advection time step. \n"//& - "Ideally DT_THERM should be an integer multiple of DT \n"//& - "and less than the forcing or coupling time-step, unless \n"//& - "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& - "can be an integer multiple of the coupling timestep. By \n"//& + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& "default DT_THERM is set to DT.", units="s", default=CS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", CS%thermo_spans_coupling, & - "If true, the MOM will take thermodynamic and tracer \n"//& - "timesteps that can be longer than the coupling timestep. \n"//& - "The actual thermodynamic timestep that is used in this \n"//& - "case is the largest integer multiple of the coupling \n"//& + "If true, the MOM will take thermodynamic and tracer "//& + "timesteps that can be longer than the coupling timestep. "//& + "The actual thermodynamic timestep that is used in this "//& + "case is the largest integer multiple of the coupling "//& "timestep that is less than or equal to DT_THERM.", default=.false.) if (bulkmixedlayer) then CS%Hmix = -1.0 ; CS%Hmix_UV = -1.0 else call get_param(param_file, "MOM", "HMIX_SFC_PROP", CS%Hmix, & - "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth \n"//& - "over which to average to find surface properties like \n"//& + "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth "//& + "over which to average to find surface properties like "//& "SST and SSS or density (but not surface velocities).", & units="m", default=1.0, scale=US%m_to_Z) call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, & - "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth\n"//& - "over which to average to find surface flow properties,\n"//& + "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth "//& + "over which to average to find surface flow properties, "//& "SSU, SSV. A non-positive value indicates no averaging.", & units="m", default=0.0, scale=US%m_to_Z) endif call get_param(param_file, "MOM", "HFREEZE", CS%HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "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) call get_param(param_file, "MOM", "MIN_Z_DIAG_INTERVAL", Z_diag_int, & - "The minimum amount of time in seconds between \n"//& - "calculations of depth-space diagnostics. Making this \n"//& - "larger than DT_THERM reduces the performance penalty \n"//& + "The minimum amount of time in seconds between "//& + "calculations of depth-space diagnostics. Making this "//& + "larger than DT_THERM reduces the performance penalty "//& "of regridding to depth online.", units="s", default=0.0) call get_param(param_file, "MOM", "INTERPOLATE_P_SURF", CS%interp_p_surf, & - "If true, linearly interpolate the surface pressure \n"//& - "over the coupling time step, using the specified value \n"//& + "If true, linearly interpolate the surface pressure "//& + "over the coupling time step, using the specified value "//& "at the end of the step.", default=.false.) if (CS%split) then @@ -1808,10 +1808,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & default_val = CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0 CS%dtbt_reset_period = -1.0 call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", CS%dtbt_reset_period, & - "The period between recalculations of DTBT (if DTBT <= 0). \n"//& - "If DTBT_RESET_PERIOD is negative, DTBT is set based \n"//& - "only on information available at initialization. If 0, \n"//& - "DTBT will be set every dynamics time step. The default \n"//& + "The period between recalculations of DTBT (if DTBT <= 0). "//& + "If DTBT_RESET_PERIOD is negative, DTBT is set based "//& + "only on information available at initialization. If 0, "//& + "DTBT will be set every dynamics time step. The default "//& "is set by DT_THERM. This is only used if SPLIT is true.", & units="s", default=default_val, do_not_read=(dtbt > 0.0)) endif @@ -1820,46 +1820,46 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & use_frazil = .false. ; bound_salinity = .false. ; CS%tv%P_Ref = 2.0e7 if (use_temperature) then call get_param(param_file, "MOM", "FRAZIL", use_frazil, & - "If true, water freezes if it gets too cold, and the \n"//& - "the accumulated heat deficit is returned in the \n"//& - "surface state. FRAZIL is only used if \n"//& + "If true, water freezes if it gets too cold, and the "//& + "the accumulated heat deficit is returned in the "//& + "surface state. FRAZIL is only used if "//& "ENABLE_THERMODYNAMICS is true.", default=.false.) call get_param(param_file, "MOM", "DO_GEOTHERMAL", use_geothermal, & "If true, apply geothermal heating.", default=.false.) call get_param(param_file, "MOM", "BOUND_SALINITY", bound_salinity, & - "If true, limit salinity to being positive. (The sea-ice \n"//& - "model may ask for more salt than is available and \n"//& + "If true, limit salinity to being positive. (The sea-ice "//& + "model may ask for more salt than is available and "//& "drive the salinity negative otherwise.)", default=.false.) call get_param(param_file, "MOM", "MIN_SALINITY", CS%tv%min_salinity, & - "The minimum value of salinity when BOUND_SALINITY=True. \n"//& - "The default is 0.01 for backward compatibility but ideally \n"//& + "The minimum value of salinity when BOUND_SALINITY=True. "//& + "The default is 0.01 for backward compatibility but ideally "//& "should be 0.", units="PPT", default=0.01, do_not_log=.not.bound_salinity) call get_param(param_file, "MOM", "C_P", CS%tv%C_p, & - "The heat capacity of sea water, approximated as a \n"//& - "constant. This is only used if ENABLE_THERMODYNAMICS is \n"//& - "true. The default value is from the TEOS-10 definition \n"//& + "The heat capacity of sea water, approximated as a "//& + "constant. This is only used if ENABLE_THERMODYNAMICS is "//& + "true. The default value is from the TEOS-10 definition "//& "of conservative temperature.", units="J kg-1 K-1", & default=3991.86795711963) endif if (use_EOS) call get_param(param_file, "MOM", "P_REF", CS%tv%P_Ref, & - "The pressure that is used for calculating the coordinate \n"//& - "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) \n"//& - "This is only used if USE_EOS and ENABLE_THERMODYNAMICS \n"//& + "The pressure that is used for calculating the coordinate "//& + "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& + "This is only used if USE_EOS and ENABLE_THERMODYNAMICS "//& "are true.", units="Pa", default=2.0e7) if (bulkmixedlayer) then call get_param(param_file, "MOM", "NKML", nkml, & - "The number of sublayers within the mixed layer if \n"//& + "The number of sublayers within the mixed layer if "//& "BULKMIXEDLAYER is true.", units="nondim", default=2) call get_param(param_file, "MOM", "NKBL", nkbl, & - "The number of layers that are used as variable density \n"//& + "The number of layers that are used as variable density "//& "buffer layers if BULKMIXEDLAYER is true.", units="nondim", & default=2) endif call get_param(param_file, "MOM", "GLOBAL_INDEXING", global_indexing, & - "If true, use a global lateral indexing convention, so \n"//& - "that corresponding points on different processors have \n"//& + "If true, use a global lateral indexing convention, so "//& + "that corresponding points on different processors have "//& "the same index. This does not work with static memory.", & default=.false., layoutParam=.true.) #ifdef STATIC_MEMORY_ @@ -1867,9 +1867,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "GLOBAL_INDEXING can not be true with STATIC_MEMORY.") #endif call get_param(param_file, "MOM", "FIRST_DIRECTION", first_direction, & - "An integer that indicates which direction goes first \n"//& - "in parts of the code that use directionally split \n"//& - "updates, with even numbers (or 0) used for x- first \n"//& + "An integer that indicates which direction goes first "//& + "in parts of the code that use directionally split "//& + "updates, with even numbers (or 0) used for x- first "//& "and odd numbers used for y-first.", default=0) call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", CS%check_bad_sfc_vals, & @@ -1877,37 +1877,37 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & default=.false.) if (CS%check_bad_sfc_vals) then call get_param(param_file, "MOM", "BAD_VAL_SSH_MAX", CS%bad_val_ssh_max, & - "The value of SSH above which a bad value message is \n"//& + "The value of SSH above which a bad value message is "//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="m", & default=20.0) call get_param(param_file, "MOM", "BAD_VAL_SSS_MAX", CS%bad_val_sss_max, & - "The value of SSS above which a bad value message is \n"//& + "The value of SSS above which a bad value message is "//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="PPT", & default=45.0) call get_param(param_file, "MOM", "BAD_VAL_SST_MAX", CS%bad_val_sst_max, & - "The value of SST above which a bad value message is \n"//& + "The value of SST above which a bad value message is "//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", & units="deg C", default=45.0) call get_param(param_file, "MOM", "BAD_VAL_SST_MIN", CS%bad_val_sst_min, & - "The value of SST below which a bad value message is \n"//& + "The value of SST below which a bad value message is "//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", & units="deg C", default=-2.1) call get_param(param_file, "MOM", "BAD_VAL_COLUMN_THICKNESS", CS%bad_val_col_thick, & - "The value of column thickness below which a bad value message is \n"//& + "The value of column thickness below which a bad value message is "//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="m", & default=0.0) endif call get_param(param_file, "MOM", "SAVE_INITIAL_CONDS", save_IC, & - "If true, write the initial conditions to a file given \n"//& + "If true, write the initial conditions to a file given "//& "by IC_OUTPUT_FILE.", default=.false.) call get_param(param_file, "MOM", "IC_OUTPUT_FILE", CS%IC_file, & "The file into which to write the initial conditions.", & default="MOM_IC") call get_param(param_file, "MOM", "WRITE_GEOM", write_geom, & - "If =0, never write the geometry and vertical grid files.\n"//& - "If =1, write the geometry and vertical grid files only for\n"//& - "a new simulation. If =2, always write the geometry and\n"//& + "If =0, never write the geometry and vertical grid files. "//& + "If =1, write the geometry and vertical grid files only for "//& + "a new simulation. If =2, always write the geometry and "//& "vertical grid files. Other values are invalid.", default=1) if (write_geom<0 .or. write_geom>2) call MOM_error(FATAL,"MOM: "//& "WRITE_GEOM must be equal to 0, 1 or 2.") @@ -1947,9 +1947,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%ensemble_ocean=.false. call get_param(param_file, "MOM", "ENSEMBLE_OCEAN", CS%ensemble_ocean, & - "If False, The model is being run in serial mode as a single realization.\n"//& - "If True, The current model realization is part of a larger ensemble \n"//& - "and at the end of step MOM, we will perform a gather of the ensemble\n"//& + "If False, The model is being run in serial mode as a single realization. "//& + "If True, The current model realization is part of a larger ensemble "//& + "and at the end of step MOM, we will perform a gather of the ensemble "//& "members for statistical evaluation and/or data assimilation.", default=.false.) call callTree_waypoint("MOM parameters read (initialize_MOM)") diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 6b4fdd8924..a897e2af13 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -951,23 +951,23 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, 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, "NOSLIP", CS%no_slip, & - "If true, no slip boundary conditions are used; otherwise \n"//& - "free slip boundary conditions are assumed. The \n"//& - "implementation of the free slip BCs on a C-grid is much \n"//& - "cleaner than the no slip BCs. The use of free slip BCs \n"//& - "is strongly encouraged, and no slip BCs are not used with \n"//& + "If true, no slip boundary conditions are used; otherwise "//& + "free slip boundary conditions are assumed. The "//& + "implementation of the free slip BCs on a C-grid is much "//& + "cleaner than the no slip BCs. The use of free slip BCs "//& + "is strongly encouraged, and no slip BCs are not used with "//& "the biharmonic viscosity.", default=.false.) call get_param(param_file, mdl, "CORIOLIS_EN_DIS", CS%Coriolis_En_Dis, & - "If true, two estimates of the thickness fluxes are used \n"//& - "to estimate the Coriolis term, and the one that \n"//& + "If true, two estimates of the thickness fluxes are used "//& + "to estimate the Coriolis term, and the one that "//& "dissipates energy relative to the other one is used.", & default=.false.) ! Set %Coriolis_Scheme ! (Select the baseline discretization for the Coriolis term) call get_param(param_file, mdl, "CORIOLIS_SCHEME", tmpstr, & - "CORIOLIS_SCHEME selects the discretization for the \n"//& + "CORIOLIS_SCHEME selects the discretization for the "//& "Coriolis terms. Valid values are: \n"//& "\t SADOURNY75_ENERGY - Sadourny, 1975; energy cons. \n"//& "\t ARAKAWA_HSU90 - Arakawa & Hsu, 1990 \n"//& @@ -998,16 +998,16 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) end select if (CS%Coriolis_Scheme == AL_BLEND) then call get_param(param_file, mdl, "CORIOLIS_BLEND_WT_LIN", CS%wt_lin_blend, & - "A weighting value for the ratio of inverse thicknesses, \n"//& - "beyond which the blending between Sadourny Energy and \n"//& - "Arakawa & Hsu goes linearly to 0 when CORIOLIS_SCHEME \n"//& + "A weighting value for the ratio of inverse thicknesses, "//& + "beyond which the blending between Sadourny Energy and "//& + "Arakawa & Hsu goes linearly to 0 when CORIOLIS_SCHEME "//& "is ARAWAKA_LAMB_BLEND. This must be between 1 and 1e-16.", & units="nondim", default=0.125) call get_param(param_file, mdl, "CORIOLIS_BLEND_F_EFF_MAX", CS%F_eff_max_blend, & - "The factor by which the maximum effective Coriolis \n"//& - "acceleration from any point can be increased when \n"//& - "blending different discretizations with the \n"//& - "ARAKAWA_LAMB_BLEND Coriolis scheme. This must be \n"//& + "The factor by which the maximum effective Coriolis "//& + "acceleration from any point can be increased when "//& + "blending different discretizations with the "//& + "ARAKAWA_LAMB_BLEND Coriolis scheme. This must be "//& "greater than 2.0 (the max value for Sadourny energy).", & units="nondim", default=4.0) CS%wt_lin_blend = min(1.0, max(CS%wt_lin_blend,1e-16)) @@ -1015,16 +1015,16 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) "CORIOLIS_BLEND_F_EFF_MAX should be at least 2.") endif - mesg = "If true, the Coriolis terms at u-points are bounded by \n"//& - "the four estimates of (f+rv)v from the four neighboring \n"//& + mesg = "If true, the Coriolis terms at u-points are bounded by "//& + "the four estimates of (f+rv)v from the four neighboring "//& "v-points, and similarly at v-points." if (CS%Coriolis_En_Dis .and. (CS%Coriolis_Scheme == SADOURNY75_ENERGY)) then - mesg = trim(mesg)//" This option is \n"//& - "always effectively false with CORIOLIS_EN_DIS defined and \n"//& + mesg = trim(mesg)//" This option is "//& + "always effectively false with CORIOLIS_EN_DIS defined and "//& "CORIOLIS_SCHEME set to "//trim(SADOURNY75_ENERGY_STRING)//"." else - mesg = trim(mesg)//" This option would \n"//& - "have no effect on the SADOURNY Coriolis scheme if it \n"//& + mesg = trim(mesg)//" This option would "//& + "have no effect on the SADOURNY Coriolis scheme if it "//& "were possible to use centered difference thickness fluxes." endif call get_param(param_file, mdl, "BOUND_CORIOLIS", CS%bound_Coriolis, mesg, & @@ -1034,7 +1034,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) ! Set KE_Scheme (selects discretization of KE) call get_param(param_file, mdl, "KE_SCHEME", tmpstr, & - "KE_SCHEME selects the discretization for acceleration \n"//& + "KE_SCHEME selects the discretization for acceleration "//& "due to the kinetic energy gradient. Valid values are: \n"//& "\t KE_ARAKAWA, KE_SIMPLE_GUDONOV, KE_GUDONOV", & default=KE_ARAKAWA_STRING) @@ -1051,7 +1051,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) ! Set PV_Adv_Scheme (selects discretization of PV advection) call get_param(param_file, mdl, "PV_ADV_SCHEME", tmpstr, & - "PV_ADV_SCHEME selects the discretization for PV \n"//& + "PV_ADV_SCHEME selects the discretization for PV "//& "advection. Valid values are: \n"//& "\t PV_ADV_CENTERED - centered (aka Sadourny, 75) \n"//& "\t PV_ADV_UPWIND1 - upwind, first order", & diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 110963789b..183817bf42 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -117,13 +117,13 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) ! 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, & - "If true the pressure gradient forces are calculated \n"//& - "with a finite volume form that analytically integrates \n"//& - "the equations of state in pressure to avoid any \n"//& - "possibility of numerical thermobaric instability, as \n"//& + "If true the pressure gradient forces are calculated "//& + "with a finite volume form that analytically integrates "//& + "the equations of state in pressure to avoid any "//& + "possibility of numerical thermobaric instability, as "//& "described in Adcroft et al., O. Mod. (2008).", default=.true.) call get_param(param_file, mdl, "BLOCKED_ANALYTIC_FV_PGF", CS%blocked_AFV, & - "If true, used the blocked version of the ANALYTIC_FV_PGF \n"//& + "If true, used the blocked version of the ANALYTIC_FV_PGF "//& "code. The value of this parameter should not change answers.", & default=.false., do_not_log=.true., debuggingParam=.true.) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 09d3e64266..42c08b8364 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -842,9 +842,9 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ mdl = "MOM_PressureForce_Mont" call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "TIDES", CS%tides, & diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index cdbfc40dfc..e68a699b7a 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -810,36 +810,36 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C mdl = "MOM_PressureForce_AFV" call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, "MOM", "USE_REGRIDDING", use_ALE, & - "If True, use the ALE algorithm (regridding/remapping).\n"//& + "If True, use the ALE algorithm (regridding/remapping). "//& "If False, use the layered isopycnal algorithm.", default=.false. ) call get_param(param_file, mdl, "MASS_WEIGHT_IN_PRESSURE_GRADIENT", CS%useMassWghtInterp, & - "If true, use mass weighting when interpolating T/S for\n"//& - "integrals near the bathymetry in AFV pressure gradient\n"//& + "If true, use mass weighting when interpolating T/S for "//& + "integrals near the bathymetry in AFV pressure gradient "//& "calculations.", default=.false.) call get_param(param_file, mdl, "RECONSTRUCT_FOR_PRESSURE", CS%reconstruct, & - "If True, use vertical reconstruction of T & S within\n"//& - "the integrals of the FV pressure gradient calculation.\n"//& - "If False, use the constant-by-layer algorithm.\n"//& + "If True, use vertical reconstruction of T & S within "//& + "the integrals of the FV pressure gradient calculation. "//& + "If False, use the constant-by-layer algorithm. "//& "The default is set by USE_REGRIDDING.", & default=use_ALE ) call get_param(param_file, mdl, "PRESSURE_RECONSTRUCTION_SCHEME", CS%Recon_Scheme, & - "Order of vertical reconstruction of T/S to use in the \n"//& + "Order of vertical reconstruction of T/S to use in the "//& "integrals within the FV pressure gradient calculation.\n"//& " 0: PCM or no reconstruction.\n"//& " 1: PLM reconstruction.\n"//& " 2: PPM reconstruction.", default=1) call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION_PRESSURE", CS%boundary_extrap, & - "If true, the reconstruction of T & S for pressure in \n"//& - "boundary cells is extrapolated, rather than using PCM \n"//& - "in these cells. If true, the same order polynomial is \n"//& + "If true, the reconstruction of T & S for pressure in "//& + "boundary cells is extrapolated, rather than using PCM "//& + "in these cells. If true, the same order polynomial is "//& "used as is used for the interior cells.", default=.true.) if (CS%tides) then diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 96af5748b6..4b602373e7 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -802,36 +802,36 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, US, param_file, diag, CS, tid mdl = "MOM_PressureForce_blk_AFV" call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, "MOM", "USE_REGRIDDING", use_ALE, & - "If True, use the ALE algorithm (regridding/remapping).\n"//& + "If True, use the ALE algorithm (regridding/remapping). "//& "If False, use the layered isopycnal algorithm.", default=.false. ) call get_param(param_file, mdl, "MASS_WEIGHT_IN_PRESSURE_GRADIENT", CS%useMassWghtInterp, & - "If true, use mass weighting when interpolating T/S for\n"//& - "integrals near the bathymetry in AFV pressure gradient\n"//& + "If true, use mass weighting when interpolating T/S for "//& + "integrals near the bathymetry in AFV pressure gradient "//& "calculations.", default=.false.) call get_param(param_file, mdl, "RECONSTRUCT_FOR_PRESSURE", CS%reconstruct, & - "If True, use vertical reconstruction of T & S within\n"//& - "the integrals of the FV pressure gradient calculation.\n"//& - "If False, use the constant-by-layer algorithm.\n"//& + "If True, use vertical reconstruction of T & S within "//& + "the integrals of the FV pressure gradient calculation. "//& + "If False, use the constant-by-layer algorithm. "//& "The default is set by USE_REGRIDDING.", & default=use_ALE ) call get_param(param_file, mdl, "PRESSURE_RECONSTRUCTION_SCHEME", CS%Recon_Scheme, & - "Order of vertical reconstruction of T/S to use in the \n"//& + "Order of vertical reconstruction of T/S to use in the "//& "integrals within the FV pressure gradient calculation.\n"//& " 0: PCM or no reconstruction.\n"//& " 1: PLM reconstruction.\n"//& " 2: PPM reconstruction.", default=1) call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION_PRESSURE", CS%boundary_extrap, & - "If true, the reconstruction of T & S for pressure in \n"//& - "boundary cells is extrapolated, rather than using PCM \n"//& - "in these cells. If true, the same order polynomial is \n"//& + "If true, the reconstruction of T & S for pressure in "//& + "boundary cells is extrapolated, rather than using PCM "//& + "in these cells. If true, the same order polynomial is "//& "used as is used for the interior cells.", default=.true.) if (CS%tides) then diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index c06943eb20..2f1eb68961 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3779,32 +3779,32 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, if (.not.CS%split) return call get_param(param_file, mdl, "BOUND_BT_CORRECTION", CS%bound_BT_corr, & - "If true, the corrective pseudo mass-fluxes into the \n"//& - "barotropic solver are limited to values that require \n"//& + "If true, the corrective pseudo mass-fluxes into the "//& + "barotropic solver are limited to values that require "//& "less than maxCFL_BT_cont to be accommodated.",default=.false.) call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", CS%BT_cont_bounds, & - "If true, and BOUND_BT_CORRECTION is true, use the \n"//& - "BT_cont_type variables to set limits determined by \n"//& - "MAXCFL_BT_CONT on the CFL number of the velocities \n"//& + "If true, and BOUND_BT_CORRECTION is true, use the "//& + "BT_cont_type variables to set limits determined by "//& + "MAXCFL_BT_CONT on the CFL number of the velocities "//& "that are likely to be driven by the corrective mass fluxes.", & default=.true.) !, do_not_log=.not.CS%bound_BT_corr) call get_param(param_file, mdl, "ADJUST_BT_CONT", CS%adjust_BT_cont, & - "If true, adjust the curve fit to the BT_cont type \n"//& - "that is used by the barotropic solver to match the \n"//& + "If true, adjust the curve fit to the BT_cont type "//& + "that is used by the barotropic solver to match the "//& "transport about which the flow is being linearized.", default=.false.) call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & - "If true, adjust the initial conditions for the \n"//& - "barotropic solver to the values from the layered \n"//& - "solution over a whole timestep instead of instantly. \n"//& - "This is a decent approximation to the inclusion of \n"//& + "If true, adjust the initial conditions for the "//& + "barotropic solver to the values from the layered "//& + "solution over a whole timestep instead of instantly. "//& + "This is a decent approximation to the inclusion of "//& "sum(u dh_dt) while also correcting for truncation errors.", & default=.false.) call get_param(param_file, mdl, "BT_USE_VISC_REM_U_UH0", CS%visc_rem_u_uh0, & - "If true, use the viscous remnants when estimating the \n"//& - "barotropic velocities that were used to calculate uh0 \n"//& + "If true, use the viscous remnants when estimating the "//& + "barotropic velocities that were used to calculate uh0 "//& "and vh0. False is probably the better choice.", default=.false.) call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", CS%use_wide_halos, & - "If true, use wide halos and march in during the \n"//& + "If true, use wide halos and march in during the "//& "barotropic time stepping for efficiency.", default=.true., & layoutParam=.true.) call get_param(param_file, mdl, "BTHALO", bt_halo_sz, & @@ -3812,7 +3812,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, layoutParam=.true.) #ifdef STATIC_MEMORY_ if ((bt_halo_sz > 0) .and. (bt_halo_sz /= BTHALO_)) call MOM_error(FATAL, & - "barotropic_init: Run-time values of BTHALO must agree with the \n"//& + "barotropic_init: Run-time values of BTHALO must agree with the "//& "macro BTHALO_ with STATIC_MEMORY_.") wd_halos(1) = WHALOI_+NIHALO_ ; wd_halos(2) = WHALOJ_+NJHALO_ #else @@ -3826,65 +3826,65 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, layoutParam=.true.) call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_BT_cont_type, & - "If true, use a structure with elements that describe \n"//& - "effective face areas from the summed continuity solver \n"//& - "as a function the barotropic flow in coupling between \n"//& - "the barotropic and baroclinic flow. This is only used \n"//& + "If true, use a structure with elements that describe "//& + "effective face areas from the summed continuity solver "//& + "as a function the barotropic flow in coupling between "//& + "the barotropic and baroclinic flow. This is only used "//& "if SPLIT is true. \n", default=.true.) call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", & CS%Nonlinear_continuity, & - "If true, use nonlinear transports in the barotropic \n"//& - "continuity equation. This does not apply if \n"//& + "If true, use nonlinear transports in the barotropic "//& + "continuity equation. This does not apply if "//& "USE_BT_CONT_TYPE is true.", default=.false.) CS%Nonlin_cont_update_period = 1 if (CS%Nonlinear_continuity) & call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", & CS%Nonlin_cont_update_period, & - "If NONLINEAR_BT_CONTINUITY is true, this is the number \n"//& - "of barotropic time steps between updates to the face \n"//& + "If NONLINEAR_BT_CONTINUITY is true, this is the number "//& + "of barotropic time steps between updates to the face "//& "areas, or 0 to update only before the barotropic stepping.",& units="nondim", default=1) call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& - "If true, step the barotropic velocity first and project \n"//& - "out the velocity tendency by 1+BEBT when calculating the \n"//& - "transport. The default (false) is to use a predictor \n"//& - "continuity step to find the pressure field, and then \n"//& - "to do a corrector continuity step using a weighted \n"//& - "average of the old and new velocities, with weights \n"//& + "If true, step the barotropic velocity first and project "//& + "out the velocity tendency by 1+BEBT when calculating the "//& + "transport. The default (false) is to use a predictor "//& + "continuity step to find the pressure field, and then "//& + "to do a corrector continuity step using a weighted "//& + "average of the old and new velocities, with weights "//& "of (1-BEBT) and BEBT.", default=.false.) call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, & - "If true, add a dynamic pressure due to a viscous ice \n"//& + "If true, add a dynamic pressure due to a viscous ice "//& "shelf, for instance.", default=.false.) if (CS%dynamic_psurf) then call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", CS%ice_strength_length, & - "The length scale at which the Rayleigh damping rate due \n"//& - "to the ice strength should be the same as if a Laplacian \n"//& + "The length scale at which the Rayleigh damping rate due "//& + "to the ice strength should be the same as if a Laplacian "//& "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", & units="m", default=1.0e4) call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & - "The minimum depth to use in limiting the size of the \n"//& - "dynamic surface pressure for stability, if \n"//& + "The minimum depth to use in limiting the size of the "//& + "dynamic surface pressure for stability, if "//& "DYNAMIC_SURFACE_PRESSURE is true..", units="m", & default=1.0e-6) call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, & - "The constant that scales the dynamic surface pressure, \n"//& - "if DYNAMIC_SURFACE_PRESSURE is true. Stable values \n"//& + "The constant that scales the dynamic surface pressure, "//& + "if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//& "are < ~1.0.", units="nondim", default=0.9) endif call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & - "If true, the Coriolis terms are discretized with the \n"//& - "Sadourny (1975) energy conserving scheme, otherwise \n"//& - "the Arakawa & Hsu scheme is used. If the internal \n"//& - "deformation radius is not resolved, the Sadourny scheme \n"//& + "If true, the Coriolis terms are discretized with the "//& + "Sadourny (1975) energy conserving scheme, otherwise "//& + "the Arakawa & Hsu scheme is used. If the internal "//& + "deformation radius is not resolved, the Sadourny scheme "//& "should probably be used.", default=.true.) call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, & - "A string describing the scheme that is used to set the \n"//& - "open face areas used for barotropic transport and the \n"//& + "A string describing the scheme that is used to set the "//& + "open face areas used for barotropic transport and the "//& "relative weights of the accelerations. Valid values are:\n"//& "\t ARITHMETIC - arithmetic mean layer thicknesses \n"//& "\t HARMONIC - harmonic mean layer thicknesses \n"//& @@ -3910,63 +3910,63 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "can only be used if USE_BT_CONT_TYPE is defined.") call get_param(param_file, mdl, "BT_STRONG_DRAG", CS%strong_drag, & - "If true, use a stronger estimate of the retarding \n"//& - "effects of strong bottom drag, by making it implicit \n"//& - "with the barotropic time-step instead of implicit with \n"//& - "the baroclinic time-step and dividing by the number of \n"//& + "If true, use a stronger estimate of the retarding "//& + "effects of strong bottom drag, by making it implicit "//& + "with the barotropic time-step instead of implicit with "//& + "the baroclinic time-step and dividing by the number of "//& "barotropic steps.", default=.false.) call get_param(param_file, mdl, "BT_LINEAR_WAVE_DRAG", CS%linear_wave_drag, & - "If true, apply a linear drag to the barotropic velocities, \n"//& - "using rates set by lin_drag_u & _v divided by the depth of \n"//& + "If true, apply a linear drag to the barotropic velocities, "//& + "using rates set by lin_drag_u & _v divided by the depth of "//& "the ocean. This was introduced to facilitate tide modeling.", & default=.false.) call get_param(param_file, mdl, "BT_WAVE_DRAG_FILE", wave_drag_file, & - "The name of the file with the barotropic linear wave drag \n"//& + "The name of the file with the barotropic linear wave drag "//& "piston velocities.", default="", do_not_log=.not.CS%linear_wave_drag) call get_param(param_file, mdl, "BT_WAVE_DRAG_VAR", wave_drag_var, & - "The name of the variable in BT_WAVE_DRAG_FILE with the \n"//& + "The name of the variable in BT_WAVE_DRAG_FILE with the "//& "barotropic linear wave drag piston velocities at h points.", & default="rH", do_not_log=.not.CS%linear_wave_drag) call get_param(param_file, mdl, "BT_WAVE_DRAG_SCALE", wave_drag_scale, & - "A scaling factor for the barotropic linear wave drag \n"//& + "A scaling factor for the barotropic linear wave drag "//& "piston velocities.", default=1.0, units="nondim", & do_not_log=.not.CS%linear_wave_drag) call get_param(param_file, mdl, "CLIP_BT_VELOCITY", CS%clip_velocity, & - "If true, limit any velocity components that exceed \n"//& - "CFL_TRUNCATE. This should only be used as a desperate \n"//& + "If true, limit any velocity components that exceed "//& + "CFL_TRUNCATE. This should only be used as a desperate "//& "debugging measure.", default=.false.) call get_param(param_file, mdl, "CFL_TRUNCATE", CS%CFL_trunc, & - "The value of the CFL number that will cause velocity \n"//& + "The value of the CFL number that will cause velocity "//& "components to be truncated; instability can occur past 0.5.", & units="nondim", default=0.5, do_not_log=.not.CS%clip_velocity) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & - "The maximum velocity allowed before the velocity \n"//& + "The maximum velocity allowed before the velocity "//& "components are truncated.", units="m s-1", default=3.0e8, & do_not_log=.not.CS%clip_velocity) call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, & - "The maximum permitted CFL number associated with the \n"//& - "barotropic accelerations from the summed velocities \n"//& + "The maximum permitted CFL number associated with the "//& + "barotropic accelerations from the summed velocities "//& "times the time-derivatives of thicknesses.", units="nondim", & default=0.25) call get_param(param_file, mdl, "VEL_UNDERFLOW", CS%vel_underflow, & - "A negligibly small velocity magnitude below which velocity \n"//& - "components are set to 0. A reasonable value might be \n"//& - "1e-30 m/s, which is less than an Angstrom divided by \n"//& + "A negligibly small velocity magnitude below which velocity "//& + "components are set to 0. A reasonable value might be "//& + "1e-30 m/s, which is less than an Angstrom divided by "//& "the age of the universe.", units="m s-1", default=0.0) call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, & - "A time-scale over which the barotropic mode solutions \n"//& - "are filtered, in seconds if positive, or as a fraction \n"//& - "of DT if negative. When used this can never be taken to \n"//& + "A time-scale over which the barotropic mode solutions "//& + "are filtered, in seconds if positive, or as a fraction "//& + "of DT if negative. When used this can never be taken to "//& "be longer than 2*dt. Set this to 0 to apply no filtering.", & units="sec or nondim", default=-0.25) call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, & "A nondimensional factor by which gtot is enhanced.", & units="nondim", default=0.0) call get_param(param_file, mdl, "SSH_EXTRA", SSH_extra, & - "An estimate of how much higher SSH might get, for use \n"//& - "in calculating the safe external wave speed. The \n"//& + "An estimate of how much higher SSH might get, for use "//& + "in calculating the safe external wave speed. The "//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & units="m", default=min(10.0,0.05*G%max_depth*US%Z_to_m), scale=US%m_to_Z) @@ -3974,33 +3974,33 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) call get_param(param_file, mdl, "DEBUG_BT", CS%debug_bt, & - "If true, write out verbose debugging data within the \n"//& - "barotropic time-stepping loop. The data volume can be \n"//& + "If true, write out verbose debugging data within the "//& + "barotropic time-stepping loop. The data volume can be "//& "quite large if this is true.", default=CS%debug, & debuggingParam=.true.) CS%linearized_BT_PV = .true. call get_param(param_file, mdl, "BEBT", CS%bebt, & - "BEBT determines whether the barotropic time stepping \n"//& - "uses the forward-backward time-stepping scheme or a \n"//& - "backward Euler scheme. BEBT is valid in the range from \n"//& - "0 (for a forward-backward treatment of nonrotating \n"//& - "gravity waves) to 1 (for a backward Euler treatment). \n"//& + "BEBT determines whether the barotropic time stepping "//& + "uses the forward-backward time-stepping scheme or a "//& + "backward Euler scheme. BEBT is valid in the range from "//& + "0 (for a forward-backward treatment of nonrotating "//& + "gravity waves) to 1 (for a backward Euler treatment). "//& "In practice, BEBT must be greater than about 0.05.", & units="nondim", default=0.1) call get_param(param_file, mdl, "DTBT", dtbt_input, & - "The barotropic time step, in s. DTBT is only used with \n"//& - "the split explicit time stepping. To set the time step \n"//& - "automatically based the maximum stable value use 0, or \n"//& - "a negative value gives the fraction of the stable value. \n"//& - "Setting DTBT to 0 is the same as setting it to -0.98. \n"//& - "The value of DTBT that will actually be used is an \n"//& + "The barotropic time step, in s. DTBT is only used with "//& + "the split explicit time stepping. To set the time step "//& + "automatically based the maximum stable value use 0, or "//& + "a negative value gives the fraction of the stable value. "//& + "Setting DTBT to 0 is the same as setting it to -0.98. "//& + "The value of DTBT that will actually be used is an "//& "integer fraction of DT, rounding down.", units="s or nondim",& default = -0.98) call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", & CS%use_old_coriolis_bracket_bug , & - "If True, use an order of operations that is not bitwise\n"//& - "rotationally symmetric in the meridional Coriolis term of\n"//& + "If True, use an order of operations that is not bitwise "//& + "rotationally symmetric in the meridional Coriolis term of "//& "the barotropic solver.", default=.false.) ! Initialize a version of the MOM domain that is specific to the barotropic solver. diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index cf4dc09897..ce69c9816c 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -148,7 +148,7 @@ subroutine continuity_init(Time, G, GV, param_file, diag, 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, & - "CONTINUITY_SCHEME selects the discretization for the \n"//& + "CONTINUITY_SCHEME selects the discretization for the "//& "continuity solver. The only valid value currently is: \n"//& "\t PPM - use a positive-definite (or monotonic) \n"//& "\t piecewise parabolic reconstruction solver.", & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 4740ce6ced..4cf410160b 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -2258,66 +2258,66 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, 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, & - "If true, CONTINUITY_PPM uses the Colella and Woodward \n"//& - "monotonic limiter. The default (false) is to use a \n"//& + "If true, CONTINUITY_PPM uses the Colella and Woodward "//& + "monotonic limiter. The default (false) is to use a "//& "simple positive definite limiter.", default=.false.) call get_param(param_file, mdl, "SIMPLE_2ND_PPM_CONTINUITY", CS%simple_2nd, & - "If true, CONTINUITY_PPM uses a simple 2nd order \n"//& - "(arithmetic mean) interpolation of the edge values. \n"//& - "This may give better PV conservation properties. While \n"//& - "it formally reduces the accuracy of the continuity \n"//& - "solver itself in the strongly advective limit, it does \n"//& - "not reduce the overall order of accuracy of the dynamic \n"//& + "If true, CONTINUITY_PPM uses a simple 2nd order "//& + "(arithmetic mean) interpolation of the edge values. "//& + "This may give better PV conservation properties. While "//& + "it formally reduces the accuracy of the continuity "//& + "solver itself in the strongly advective limit, it does "//& + "not reduce the overall order of accuracy of the dynamic "//& "core.", default=.false.) call get_param(param_file, mdl, "UPWIND_1ST_CONTINUITY", CS%upwind_1st, & - "If true, CONTINUITY_PPM becomes a 1st-order upwind \n"//& - "continuity solver. This scheme is highly diffusive \n"//& - "but may be useful for debugging or in single-column \n"//& + "If true, CONTINUITY_PPM becomes a 1st-order upwind "//& + "continuity solver. This scheme is highly diffusive "//& + "but may be useful for debugging or in single-column "//& "mode where its minimal stencil is useful.", default=.false.) call get_param(param_file, mdl, "ETA_TOLERANCE", CS%tol_eta, & - "The tolerance for the differences between the \n"//& - "barotropic and baroclinic estimates of the sea surface \n"//& - "height due to the fluxes through each face. The total \n"//& - "tolerance for SSH is 4 times this value. The default \n"//& - "is 0.5*NK*ANGSTROM, and this should not be set less x\n"//& + "The tolerance for the differences between the "//& + "barotropic and baroclinic estimates of the sea surface "//& + "height due to the fluxes through each face. The total "//& + "tolerance for SSH is 4 times this value. The default "//& + "is 0.5*NK*ANGSTROM, and this should not be set less "//& "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m) call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & - "The tolerance for free-surface height discrepancies \n"//& - "between the barotropic solution and the sum of the \n"//& - "layer thicknesses when calculating the auxiliary \n"//& - "corrected velocities. By default, this is the same as \n"//& + "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) call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & - "The tolerance for barotropic velocity discrepancies \n"//& - "between the barotropic solution and the sum of the \n"//& + "The tolerance for barotropic velocity discrepancies "//& + "between the barotropic solution and the sum of the "//& "layer thicknesses.", units="m s-1", default=3.0e8) ! The speed of light is the default. call get_param(param_file, mdl, "CONT_PPM_AGGRESS_ADJUST", CS%aggress_adjust,& - "If true, allow the adjusted velocities to have a \n"//& + "If true, allow the adjusted velocities to have a "//& "relative CFL change up to 0.5.", default=.false.) CS%vol_CFL = CS%aggress_adjust call get_param(param_file, mdl, "CONT_PPM_VOLUME_BASED_CFL", CS%vol_CFL, & - "If true, use the ratio of the open face lengths to the \n"//& - "tracer cell areas when estimating CFL numbers. The \n"//& + "If true, use the ratio of the open face lengths to the "//& + "tracer cell areas when estimating CFL numbers. The "//& "default is set by CONT_PPM_AGGRESS_ADJUST.", & default=CS%aggress_adjust, do_not_read=CS%aggress_adjust) call get_param(param_file, mdl, "CONTINUITY_CFL_LIMIT", CS%CFL_limit_adjust, & "The maximum CFL of the adjusted velocities.", units="nondim", & default=0.5) call get_param(param_file, mdl, "CONT_PPM_BETTER_ITER", CS%better_iter, & - "If true, stop corrective iterations using a velocity \n"//& - "based criterion and only stop if the iteration is \n"//& + "If true, stop corrective iterations using a velocity "//& + "based criterion and only stop if the iteration is "//& "better than all predecessors.", default=.true.) call get_param(param_file, mdl, "CONT_PPM_USE_VISC_REM_MAX", & CS%use_visc_rem_max, & - "If true, use more appropriate limiting bounds for \n"//& + "If true, use more appropriate limiting bounds for "//& "corrections in strongly viscous columns.", default=.true.) call get_param(param_file, mdl, "CONT_PPM_MARGINAL_FACE_AREAS", CS%marginal_faces, & - "If true, use the marginal face areas from the continuity \n"//& - "solver for use as the weights in the barotropic solver. \n"//& + "If true, use the marginal face areas from the continuity "//& + "solver for use as the weights in the barotropic solver. "//& "Otherwise use the transport averaged areas.", default=.true.) CS%diag => diag diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c87154b587..d862fae71d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1023,28 +1023,28 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, mdl, "BE", CS%be, & - "If SPLIT is true, BE determines the relative weighting \n"//& - "of a 2nd-order Runga-Kutta baroclinic time stepping \n"//& - "scheme (0.5) and a backward Euler scheme (1) that is \n"//& - "used for the Coriolis and inertial terms. BE may be \n"//& - "from 0.5 to 1, but instability may occur near 0.5. \n"//& - "BE is also applicable if SPLIT is false and USE_RK2 \n"//& + "If SPLIT is true, BE determines the relative weighting "//& + "of a 2nd-order Runga-Kutta baroclinic time stepping "//& + "scheme (0.5) and a backward Euler scheme (1) that is "//& + "used for the Coriolis and inertial terms. BE may be "//& + "from 0.5 to 1, but instability may occur near 0.5. "//& + "BE is also applicable if SPLIT is false and USE_RK2 "//& "is true.", units="nondim", default=0.6) call get_param(param_file, mdl, "BEGW", CS%begw, & - "If SPLIT is true, BEGW is a number from 0 to 1 that \n"//& - "controls the extent to which the treatment of gravity \n"//& - "waves is forward-backward (0) or simulated backward \n"//& - "Euler (1). 0 is almost always used.\n"//& - "If SPLIT is false and USE_RK2 is true, BEGW can be \n"//& + "If SPLIT is true, BEGW is a 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. "//& + "If SPLIT is false and USE_RK2 is true, BEGW can be "//& "between 0 and 0.5 to damp gravity waves.", & units="nondim", default=0.0) call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & - "If true, provide the bottom stress calculated by the \n"//& + "If true, provide the bottom stress calculated by the "//& "vertical viscosity to the barotropic solver.", default=.false.) call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & - "If true, use the summed layered fluxes plus an \n"//& - "adjustment due to the change in the barotropic velocity \n"//& + "If true, use the summed layered fluxes plus an "//& + "adjustment due to the change in the barotropic velocity "//& "in the barotropic continuity equation.", default=.true.) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index c3525801a0..be81a8b25e 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -575,19 +575,19 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag CS%diag => diag call get_param(param_file, mdl, "BE", CS%be, & - "If SPLIT is true, BE determines the relative weighting \n"//& - "of a 2nd-order Runga-Kutta baroclinic time stepping \n"//& - "scheme (0.5) and a backward Euler scheme (1) that is \n"//& - "used for the Coriolis and inertial terms. BE may be \n"//& - "from 0.5 to 1, but instability may occur near 0.5. \n"//& - "BE is also applicable if SPLIT is false and USE_RK2 \n"//& + "If SPLIT is true, BE determines the relative weighting "//& + "of a 2nd-order Runga-Kutta baroclinic time stepping "//& + "scheme (0.5) and a backward Euler scheme (1) that is "//& + "used for the Coriolis and inertial terms. BE may be "//& + "from 0.5 to 1, but instability may occur near 0.5. "//& + "BE is also applicable if SPLIT is false and USE_RK2 "//& "is true.", units="nondim", default=0.6) call get_param(param_file, mdl, "BEGW", CS%begw, & - "If SPLIT is true, BEGW is a number from 0 to 1 that \n"//& - "controls the extent to which the treatment of gravity \n"//& - "waves is forward-backward (0) or simulated backward \n"//& - "Euler (1). 0 is almost always used.\n"//& - "If SPLIT is false and USE_RK2 is true, BEGW can be \n"//& + "If SPLIT is true, BEGW is a 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. "//& + "If SPLIT is false and USE_RK2 is true, BEGW can be "//& "between 0 and 0.5 to damp gravity waves.", & units="nondim", default=0.0) call get_param(param_file, mdl, "DEBUG", CS%debug, & diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ed42f6367d..5624167170 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -306,7 +306,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) allocate(OBC) call log_version(param_file, mdl, version, & - "Controls where open boundaries are located, what kind of boundary condition \n"//& + "Controls where open boundaries are located, what kind of boundary condition "//& "to impose, and what data to apply, if any.") call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & "The number of open boundary segments.", & @@ -315,7 +315,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "OBC_USER_CONFIG", config1, & - "A string that sets how the open boundary conditions are \n"//& + "A string that sets how the open boundary conditions are "//& " configured: \n", default="none", do_not_log=.true.) call get_param(param_file, mdl, "NK", OBC%ke, & "The number of model layers", default=0, do_not_log=.true.) @@ -327,16 +327,16 @@ subroutine open_boundary_config(G, US, param_file, OBC) "If true, sets relative vorticity to zero on open boundaries.", & default=.false.) call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & - "If true, sets the normal gradient of tangential velocity to\n"// & - "zero in the relative vorticity on open boundaries. This cannot\n"// & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the relative vorticity on open boundaries. This cannot "//& "be true if another OBC_XXX_VORTICITY option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & - "If true, uses the external values of tangential velocity\n"// & - "in the relative vorticity on open boundaries. This cannot\n"// & + "If true, uses the external values of tangential velocity "//& + "in the relative vorticity on open boundaries. This cannot "//& "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) call get_param(param_file, mdl, "OBC_SPECIFIED_VORTICITY", OBC%specified_vorticity, & - "If true, uses the external values of tangential velocity\n"// & - "in the relative vorticity on open boundaries. This cannot\n"// & + "If true, uses the external values of tangential velocity "//& + "in the relative vorticity on open boundaries. This cannot "//& "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) if ((OBC%zero_vorticity .and. OBC%freeslip_vorticity) .or. & (OBC%zero_vorticity .and. OBC%computed_vorticity) .or. & @@ -351,16 +351,16 @@ subroutine open_boundary_config(G, US, param_file, OBC) "If true, sets the strain used in the stress tensor to zero on open boundaries.", & default=.false.) call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & - "If true, sets the normal gradient of tangential velocity to\n"// & - "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the strain use in the stress tensor on open boundaries. This cannot "//& "be true if another OBC_XXX_STRAIN option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & - "If true, sets the normal gradient of tangential velocity to\n"// & - "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the strain use in the stress tensor on open boundaries. This cannot "//& "be true if another OBC_XXX_STRAIN option is True.", default=.false.) call get_param(param_file, mdl, "OBC_SPECIFIED_STRAIN", OBC%specified_strain, & - "If true, sets the normal gradient of tangential velocity to\n"// & - "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the strain use in the stress tensor on open boundaries. This cannot "//& "be true if another OBC_XXX_STRAIN option is True.", default=.false.) if ((OBC%zero_strain .and. OBC%freeslip_strain) .or. & (OBC%zero_strain .and. OBC%computed_strain) .or. & @@ -368,11 +368,11 @@ subroutine open_boundary_config(G, US, param_file, OBC) (OBC%freeslip_strain .and. OBC%computed_strain) .or. & (OBC%freeslip_strain .and. OBC%specified_strain) .or. & (OBC%computed_strain .and. OBC%specified_strain)) & - call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& - "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN, OBC_COMPUTED_STRAIN\n"//& + call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config: \n"//& + "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN, OBC_COMPUTED_STRAIN \n"//& "and OBC_IMPORTED_STRAIN can be True at once.") call get_param(param_file, mdl, "OBC_ZERO_BIHARMONIC", OBC%zero_biharmonic, & - "If true, zeros the Laplacian of flow on open boundaries in the biharmonic\n"//& + "If true, zeros the Laplacian of flow on open boundaries in the biharmonic "//& "viscosity term.", default=.false.) call get_param(param_file, mdl, "MASK_OUTSIDE_OBCS", mask_outside, & "If true, set the areas outside open boundaries to be land.", & @@ -382,16 +382,16 @@ subroutine open_boundary_config(G, US, param_file, OBC) call get_param(param_file, mdl, "DEBUG_OBC", debug_OBC, default=.false.) if (debug_OBC .or. debug) & call log_param(param_file, mdl, "DEBUG_OBC", debug_OBC, & - "If true, do additional calls to help debug the performance \n"//& + "If true, do additional calls to help debug the performance "//& "of the open boundary condition code.", default=.false., & debuggingParam=.true.) call get_param(param_file, mdl, "OBC_SILLY_THICK", OBC%silly_h, & - "A silly value of thicknesses used outside of open boundary \n"//& + "A silly value of thicknesses used outside of open boundary "//& "conditions for debugging.", units="m", default=0.0, & do_not_log=.not.debug_OBC, debuggingParam=.true.) call get_param(param_file, mdl, "OBC_SILLY_VEL", OBC%silly_u, & - "A silly value of velocities used outside of open boundary \n"//& + "A silly value of velocities used outside of open boundary "//& "conditions for debugging.", units="m/s", default=0.0, & do_not_log=.not.debug_OBC, debuggingParam=.true.) reentrant_x = .false. @@ -449,15 +449,15 @@ subroutine open_boundary_config(G, US, param_file, OBC) if (open_boundary_query(OBC, apply_open_OBC=.true.)) then call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & - "The maximum magnitude of the baroclinic radiation \n"//& - "velocity (or speed of characteristics). This is only \n"//& + "The maximum magnitude of the baroclinic radiation "//& + "velocity (or speed of characteristics). This is only "//& "used if one of the open boundary segments is using Orlanski.", & units="m s-1", default=10.0) call get_param(param_file, mdl, "OBC_RAD_VEL_WT", OBC%gamma_uv, & - "The relative weighting for the baroclinic radiation \n"//& - "velocities (or speed of characteristics) at the new \n"//& - "time level (1) or the running mean (0) for velocities. \n"//& - "Valid values range from 0 to 1. This is only used if \n"//& + "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. "//& + "Valid values range from 0 to 1. This is only used if "//& "one of the open boundary segments is using Orlanski.", & units="nondim", default=0.3) endif @@ -466,13 +466,13 @@ subroutine open_boundary_config(G, US, param_file, OBC) Lscale_out = 0. if (open_boundary_query(OBC, apply_open_OBC=.true.)) then call get_param(param_file, mdl, "OBC_TRACER_RESERVOIR_LENGTH_SCALE_OUT ", Lscale_out, & - "An effective length scale for restoring the tracer concentration \n"//& - "at the boundaries to externally imposed values when the flow \n"//& + "An effective length scale for restoring the tracer concentration "//& + "at the boundaries to externally imposed values when the flow "//& "is exiting the domain.", units="m", default=0.0) call get_param(param_file, mdl, "OBC_TRACER_RESERVOIR_LENGTH_SCALE_IN ", Lscale_in, & - "An effective length scale for restoring the tracer concentration \n"//& - "at the boundaries to values from the interior when the flow \n"//& + "An effective length scale for restoring the tracer concentration "//& + "at the boundaries to values from the interior when the flow "//& "is entering the domain.", units="m", default=0.0) endif @@ -547,21 +547,21 @@ subroutine initialize_segment_data(G, OBC, PF) inputdir = slasher(inputdir) call get_param(PF, mdl, "REMAPPING_SCHEME", remappingScheme, & - "This sets the reconstruction scheme used\n"//& - "for vertical remapping for all variables.\n"//& - "It can be one of the following schemes:\n"//& + "This sets the reconstruction scheme used "//& + "for vertical remapping for all variables. "//& + "It can be one of the following schemes: \n"//& trim(remappingSchemesDoc), default=remappingDefaultScheme,do_not_log=.true.) call get_param(PF, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & - "If true, cell-by-cell reconstructions are checked for\n"//& - "consistency and if non-monotonicity or an inconsistency is\n"//& + "If true, cell-by-cell reconstructions are checked for "//& + "consistency and if non-monotonicity or an inconsistency is "//& "detected then a FATAL error is issued.", default=.false.,do_not_log=.true.) call get_param(PF, mdl, "FATAL_CHECK_REMAPPING", check_remapping, & - "If true, the results of remapping are checked for\n"//& - "conservation and new extrema and if an inconsistency is\n"//& + "If true, the results of remapping are checked for "//& + "conservation and new extrema and if an inconsistency is "//& "detected then a FATAL error is issued.", default=.false.,do_not_log=.true.) call get_param(PF, mdl, "REMAP_BOUND_INTERMEDIATE_VALUES", force_bounds_in_subcell, & - "If true, the values on the intermediate grid used for remapping\n"//& - "are forced to be bounded, which might not be the case due to\n"//& + "If true, the values on the intermediate grid used for remapping "//& + "are forced to be bounded, which might not be the case due to "//& "round off.", default=.false.,do_not_log=.true.) call get_param(PF, mdl, "BRUSHCUTTER_MODE", OBC%brushcutter_mode, & "If true, read external OBC data on the supergrid.", & @@ -863,8 +863,8 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) write(segment_param_str(1:43),"('OBC_SEGMENT_',i3.3,'_VELOCITY_NUDGING_TIMESCALES')") l_seg allocate(tnudge(2)) call get_param(PF, mdl, segment_param_str(1:43), tnudge, & - "Timescales in days for nudging along a segment,\n"//& - "for inflow, then outflow. Setting both to zero should\n"//& + "Timescales in days for nudging along a segment, "//& + "for inflow, then outflow. Setting both to zero should "//& "behave like SIMPLE obcs for the baroclinic velocities.", & fail_if_missing=.true.,default=0.,units="days") OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. @@ -892,7 +892,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & - call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc:\n"//& + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc: \n"//& "Orlanski and Oblique OBC options cannot be used together on one segment.") end subroutine setup_u_point_obc @@ -987,8 +987,8 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) write(segment_param_str(1:43),"('OBC_SEGMENT_',i3.3,'_VELOCITY_NUDGING_TIMESCALES')") l_seg allocate(tnudge(2)) call get_param(PF, mdl, segment_param_str(1:43), tnudge, & - "Timescales in days for nudging along a segment,\n"//& - "for inflow, then outflow. Setting both to zero should\n"//& + "Timescales in days for nudging along a segment, "//& + "for inflow, then outflow. Setting both to zero should "//& "behave like SIMPLE obcs for the baroclinic velocities.", & fail_if_missing=.true.,default=0.,units="days") OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. @@ -1016,7 +1016,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & - call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc:\n"//& + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc: \n"//& "Orlanski and Oblique OBC options cannot be used together on one segment.") end subroutine setup_v_point_obc diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 31552948e1..83fb6d9268 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -92,9 +92,9 @@ subroutine verticalGridInit( param_file, GV, US ) "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", GV%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & @@ -103,7 +103,7 @@ subroutine verticalGridInit( param_file, GV, US ) "The minimum layer thickness, usually one-Angstrom.", & units="m", default=1.0e-10) call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, & - "An integer power of 2 that is used to rescale the model's \n"//& + "An integer power of 2 that is used to rescale the model's "//& "intenal units of thickness. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) if (abs(H_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& @@ -112,13 +112,13 @@ subroutine verticalGridInit( param_file, GV, US ) if (H_power /= 0) H_rescale_factor = 2.0**H_power if (.not.GV%Boussinesq) then call get_param(param_file, mdl, "H_TO_KG_M2", GV%H_to_kg_m2,& - "A constant that translates thicknesses from the model's \n"//& + "A constant that translates thicknesses from the model's "//& "internal units of thickness to kg m-2.", units="kg m-2 H-1", & default=1.0) GV%H_to_kg_m2 = GV%H_to_kg_m2 * H_rescale_factor else call get_param(param_file, mdl, "H_TO_M", GV%H_to_m, & - "A constant that translates the model's internal \n"//& + "A constant that translates the model's internal "//& "units of thickness into m.", units="m H-1", default=1.0) GV%H_to_m = GV%H_to_m * H_rescale_factor endif diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index a642cd0205..9c2f0b6adf 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -758,17 +758,17 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, 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, "U_TRUNC_FILE", CS%u_trunc_file, & - "The absolute path to the file where the accelerations \n"//& + "The absolute path to the file where the accelerations "//& "leading to zonal velocity truncations are written. \n"//& - "Leave this empty for efficiency if this diagnostic is \n"//& + "Leave this empty for efficiency if this diagnostic is "//& "not needed.", default="", debuggingParam=.true.) call get_param(param_file, mdl, "V_TRUNC_FILE", CS%v_trunc_file, & - "The absolute path to the file where the accelerations \n"//& + "The absolute path to the file where the accelerations "//& "leading to meridional velocity truncations are written. \n"//& - "Leave this empty for efficiency if this diagnostic is \n"//& + "Leave this empty for efficiency if this diagnostic is "//& "not needed.", default="", debuggingParam=.true.) call get_param(param_file, mdl, "MAX_TRUNC_FILE_SIZE_PER_PE", CS%max_writes, & - "The maximum number of colums of truncations that any PE \n"//& + "The maximum number of colums of truncations that any PE "//& "will write out during a run.", default=50, debuggingParam=.true.) if (len_trim(dirs%output_directory) > 0) then diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 79a56cae2f..d4d267d50d 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -88,11 +88,11 @@ subroutine MOM_debugging_init(param_file) "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) call get_param(param_file, mdl, "DEBUG_CHKSUMS", debug_chksums, & - "If true, checksums are performed on arrays in the \n"//& + "If true, checksums are performed on arrays in the "//& "various vec_chksum routines.", default=debug, & debuggingParam=.true.) call get_param(param_file, mdl, "DEBUG_REDUNDANT", debug_redundant, & - "If true, debug redundant data points during calls to \n"//& + "If true, debug redundant data points during calls to "//& "the various vec_chksum routines.", default=debug, & debuggingParam=.true.) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 3c50f00061..05e3d1486c 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -997,8 +997,8 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, "") ! Read in z-space info from a NetCDF file. call get_param(param_file, mdl, "Z_OUTPUT_GRID_FILE", zgrid_file, & - "The file that specifies the vertical grid for \n"//& - "depth-space diagnostics, or blank to disable \n"//& + "The file that specifies the vertical grid for "//& + "depth-space diagnostics, or blank to disable "//& "depth-space output.", default="") if (len_trim(zgrid_file) > 0) then @@ -1011,7 +1011,7 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, US, param_file, diag, CS) call log_param(param_file, mdl, "!INPUTDIR/Z_OUTPUT_GRID_FILE", & trim(in_dir)//trim(zgrid_file)) call log_param(param_file, mdl, "!NK_ZSPACE (from file)", CS%nk_zspace, & - "The number of depth-space levels. This is determined \n"//& + "The number of depth-space levels. This is determined "//& "from the size of the variable zw in the output grid file.", & units="nondim") else diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 767625f1ea..859962c369 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1450,11 +1450,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version) call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_COLUMN_FRACTION", CS%mono_N2_column_fraction, & - "The lower fraction of water column over which N2 is limited as monotonic\n"// & + "The lower fraction of water column over which N2 is limited as monotonic "// & "for the purposes of calculating the equivalent barotropic wave speed.", & units='nondim', default=0.) call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_DEPTH", CS%mono_N2_depth, & - "The depth below which N2 is limited as monotonic for the\n"// & + "The depth below which N2 is limited as monotonic for the "// & "purposes of calculating the equivalent barotropic wave speed.", & units='m', default=-1.) diff --git a/src/diagnostics/MOM_obsolete_diagnostics.F90 b/src/diagnostics/MOM_obsolete_diagnostics.F90 index 4bd5b61255..e30749984d 100644 --- a/src/diagnostics/MOM_obsolete_diagnostics.F90 +++ b/src/diagnostics/MOM_obsolete_diagnostics.F90 @@ -31,8 +31,8 @@ subroutine register_obsolete_diagnostics(param_file, diag) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "OBSOLETE_DIAGNOSTIC_IS_FATAL", causeFatal, & - "If an obsolete diagnostic variable appears in the diag_table\n"// & - "then cause a FATAL error rather than issue a WARNING.", default=.true.) + "If an obsolete diagnostic variable appears in the diag_table, "// & + "cause a FATAL error rather than issue a WARNING.", default=.true.) foundEntry = .false. ! Each obsolete entry, with replacement name is available. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index eb4214ea10..9399f73a58 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -169,41 +169,41 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & ! 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, & - "If true, calculate the available potential energy of \n"//& - "the interfaces. Setting this to false reduces the \n"//& + "If true, calculate the available potential energy of "//& + "the interfaces. Setting this to false reduces the "//& "memory footprint of high-PE-count models dramatically.", & default=.true.) call get_param(param_file, mdl, "WRITE_STOCKS", CS%write_stocks, & - "If true, write the integrated tracer amounts to stdout \n"//& + "If true, write the integrated tracer amounts to stdout "//& "when the energy files are written.", default=.true.) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "DT", CS%dt, & "The (baroclinic) dynamics time step.", units="s", & fail_if_missing=.true.) call get_param(param_file, mdl, "MAXTRUNC", CS%maxtrunc, & - "The run will be stopped, and the day set to a very \n"//& - "large value if the velocity is truncated more than \n"//& - "MAXTRUNC times between energy saves. Set MAXTRUNC to 0 \n"//& + "The run will be stopped, and the day set to a very "//& + "large value if the velocity is truncated more than "//& + "MAXTRUNC times between energy saves. Set MAXTRUNC to 0 "//& "to stop if there is any truncation of velocities.", & units="truncations save_interval-1", default=0) call get_param(param_file, mdl, "MAX_ENERGY", CS%max_Energy, & - "The maximum permitted average energy per unit mass; the \n"//& - "model will be stopped if there is more energy than \n"//& + "The maximum permitted average energy per unit mass; the "//& + "model will be stopped if there is more energy than "//& "this. If zero or negative, this is set to 10*MAXVEL^2.", & units="m2 s-2", default=0.0) if (CS%max_Energy <= 0.0) then call get_param(param_file, mdl, "MAXVEL", maxvel, & - "The maximum velocity allowed before the velocity \n"//& + "The maximum velocity allowed before the velocity "//& "components are truncated.", units="m s-1", default=3.0e8) CS%max_Energy = 10.0 * maxvel**2 call log_param(param_file, mdl, "MAX_ENERGY as used", CS%max_Energy) endif call get_param(param_file, mdl, "ENERGYFILE", energyfile, & - "The file to use to write the energies and globally \n"//& + "The file to use to write the energies and globally "//& "summed diagnostics.", default="ocean.stats") !query fms_io if there is a filename_appendix (for ensemble runs) @@ -230,10 +230,10 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & if (CS%do_APE_calc) then call get_param(param_file, mdl, "READ_DEPTH_LIST", CS%read_depth_list, & - "Read the depth list from a file if it exists or \n"//& + "Read the depth list from a file if it exists or "//& "create that file otherwise.", default=.false.) call get_param(param_file, mdl, "DEPTH_LIST_MIN_INC", CS%D_list_min_inc, & - "The minimum increment between the depths of the \n"//& + "The minimum increment between the depths of the "//& "entries in the depth-list file.", & units="m", default=1.0E-10, scale=US%m_to_Z) if (CS%read_depth_list) then @@ -244,12 +244,12 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & call get_param(param_file, mdl, "REQUIRE_DEPTH_LIST_CHECKSUMS", & CS%require_depth_list_chksum, & - "Require that matching checksums be in Depth_list.nc\n" // & + "Require that matching checksums be in Depth_list.nc "//& "when reading the file.", default=.true.) if (.not. CS%require_depth_list_chksum) & call get_param(param_file, mdl, "UPDATE_DEPTH_LIST_CHECKSUMS", & CS%update_depth_list_chksum, & - "Automatically update the Depth_list.nc file if the\n" // & + "Automatically update the Depth_list.nc file if the "//& "checksums are missing or do not match current values.", & default=.false.) endif @@ -264,12 +264,12 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & "The time unit for ENERGYSAVEDAYS.", & units="s", default=86400.0) call get_param(param_file, mdl, "ENERGYSAVEDAYS",CS%energysavedays, & - "The interval in units of TIMEUNIT between saves of the \n"//& + "The interval in units of TIMEUNIT between saves of the "//& "energies of the run and other globally summed diagnostics.",& default=set_time(0,days=1), timeunit=Time_unit) call get_param(param_file, mdl, "ENERGYSAVEDAYS_GEOMETRIC",CS%energysavedays_geometric, & - "The starting interval in units of TIMEUNIT for the first call \n"//& - "to save the energies of the run and other globally summed diagnostics. \n"//& + "The starting interval in units of TIMEUNIT for the first call "//& + "to save the energies of the run and other globally summed diagnostics. "//& "The interval increases by a factor of 2. after each call to write_energy.",& default=set_time(seconds=0), timeunit=Time_unit) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 7706b0391f..d3b056827b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -719,9 +719,9 @@ subroutine EOS_init(param_file, EOS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "EQN_OF_STATE", tmpstr, & - "EQN_OF_STATE determines which ocean equation of state \n"//& - "should be used. Currently, the valid choices are \n"//& - '"LINEAR", "UNESCO", "WRIGHT", "NEMO" and "TEOS10". \n'//& + "EQN_OF_STATE determines which ocean equation of state "//& + "should be used. Currently, the valid choices are "//& + '"LINEAR", "UNESCO", "WRIGHT", "NEMO" and "TEOS10". '//& "This is only used if USE_EOS is true.", default=EOS_DEFAULT) select case (uppercase(tmpstr)) case (EOS_LINEAR_STRING) @@ -744,26 +744,26 @@ subroutine EOS_init(param_file, EOS) if (EOS%form_of_EOS == EOS_LINEAR) then EOS%Compressible = .false. call get_param(param_file, mdl, "RHO_T0_S0", EOS%Rho_T0_S0, & - "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", \n"//& + "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", "//& "this is the density at T=0, S=0.", units="kg m-3", & default=1000.0) call get_param(param_file, mdl, "DRHO_DT", EOS%dRho_dT, & - "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", \n"//& - "this is the partial derivative of density with \n"//& + "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", "//& + "this is the partial derivative of density with "//& "temperature.", units="kg m-3 K-1", default=-0.2) call get_param(param_file, mdl, "DRHO_DS", EOS%dRho_dS, & - "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", \n"//& - "this is the partial derivative of density with \n"//& + "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", "//& + "this is the partial derivative of density with "//& "salinity.", units="kg m-3 PSU-1", default=0.8) endif call get_param(param_file, mdl, "EOS_QUADRATURE", EOS%EOS_quadrature, & - "If true, always use the generic (quadrature) code \n"//& + "If true, always use the generic (quadrature) code "//& "code for the integrals of density.", default=.false.) call get_param(param_file, mdl, "TFREEZE_FORM", tmpstr, & - "TFREEZE_FORM determines which expression should be \n"//& - "used for the freezing point. Currently, the valid \n"//& + "TFREEZE_FORM determines which expression should be "//& + "used for the freezing point. Currently, the valid "//& 'choices are "LINEAR", "MILLERO_78", "TEOS10"', & default=TFREEZE_DEFAULT) select case (uppercase(tmpstr)) @@ -780,17 +780,17 @@ subroutine EOS_init(param_file, EOS) if (EOS%form_of_TFreeze == TFREEZE_LINEAR) then call get_param(param_file, mdl, "TFREEZE_S0_P0",EOS%TFr_S0_P0, & - "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", \n"//& - "this is the freezing potential temperature at \n"//& + "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", "//& + "this is the freezing potential temperature at "//& "S=0, P=0.", units="deg C", default=0.0) call get_param(param_file, mdl, "DTFREEZE_DS",EOS%dTFr_dS, & - "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", \n"//& - "this is the derivative of the freezing potential \n"//& + "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", "//& + "this is the derivative of the freezing potential "//& "temperature with salinity.", & units="deg C PSU-1", default=-0.054) call get_param(param_file, mdl, "DTFREEZE_DP",EOS%dTFr_dP, & - "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", \n"//& - "this is the derivative of the freezing potential \n"//& + "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", "//& + "this is the derivative of the freezing potential "//& "temperature with pressure.", & units="deg C Pa-1", default=0.0) endif diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 13be17a53b..4c91518e51 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -2914,21 +2914,21 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & - 'The number of diagnostic vertical coordinates to use.\n'//& + 'The number of diagnostic vertical coordinates to use. '//& 'For each coordinate, an entry in DIAG_COORDS must be provided.', & default=1) if (diag_cs%num_diag_coords>0) then allocate(diag_coords(diag_cs%num_diag_coords)) if (diag_cs%num_diag_coords==1) then ! The default is to provide just one instance of Z* call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & - 'A list of string tuples associating diag_table modules to\n'//& - 'a coordinate definition used for diagnostics. Each string\n'//& + 'A list of string tuples associating diag_table modules to '//& + 'a coordinate definition used for diagnostics. Each string '//& 'is of the form "MODULE_SUFFIX PARAMETER_SUFFIX COORDINATE_NAME".', & default='z Z ZSTAR') else ! If using more than 1 diagnostic coordinate, all must be explicitly defined call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & - 'A list of string tuples associating diag_table modules to\n'//& - 'a coordinate definition used for diagnostics. Each string\n'//& + 'A list of string tuples associating diag_table modules to '//& + 'a coordinate definition used for diagnostics. Each string '//& 'is of the form "MODULE_SUFFIX,PARAMETER_SUFFIX,COORDINATE_NAME".', & fail_if_missing=.true.) endif @@ -2944,7 +2944,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) 'Set the default missing value to use for diagnostics.', & default=1.e20) call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & - 'Instead of writing diagnostics to the diag manager, write\n'//& + 'Instead of writing diagnostics to the diag manager, write '//& 'a text file containing the checksum (bitcount) of the array.', & default=.false.) @@ -2982,7 +2982,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "available_diags."//this_pe call get_param(param_file, mdl, "AVAILABLE_DIAGS_FILE", doc_file, & - "A file into which to write a list of all available \n"//& + "A file into which to write a list of all available "//& "ocean diagnostics that can be included in a diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%available_diag_doc_unit/=-1)) if (len_trim(doc_file) > 0) then @@ -3020,7 +3020,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "chksum_diag."//this_pe call get_param(param_file, mdl, "CHKSUM_DIAG_FILE", doc_file, & - "A file into which to write all checksums of the \n"//& + "A file into which to write all checksums of the "//& "diagnostics listed in the diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%chksum_diag_doc_unit/=-1)) if (len_trim(doc_file) > 0) then diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index e53ec98f5c..64fddfe7fc 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -1267,7 +1267,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & "If true, the domain is meridionally reentrant.", & default=.false.) call get_param(param_file, mdl, "TRIPOLAR_N", tripolar_N, & - "Use tripolar connectivity at the northern edge of the \n"//& + "Use tripolar connectivity at the northern edge of the "//& "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & default=.false.) @@ -1307,19 +1307,19 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & !$ endif #endif call log_param(param_file, mdl, "!SYMMETRIC_MEMORY_", MOM_dom%symmetric, & - "If defined, the velocity point data domain includes \n"//& - "every face of the thickness points. In other words, \n"//& - "some arrays are larger than others, depending on where \n"//& - "they are on the staggered grid. Also, the starting \n"//& - "index of the velocity-point arrays is usually 0, not 1. \n"//& + "If defined, the velocity point data domain includes "//& + "every face of the thickness points. In other words, "//& + "some arrays are larger than others, depending on where "//& + "they are on the staggered grid. Also, the starting "//& + "index of the velocity-point arrays is usually 0, not 1. "//& "This can only be set at compile time.",& layoutParam=.true.) call get_param(param_file, mdl, "NONBLOCKING_UPDATES", MOM_dom%nonblocking_updates, & "If true, non-blocking halo updates may be used.", & default=.false., layoutParam=.true.) call get_param(param_file, mdl, "THIN_HALO_UPDATES", MOM_dom%thin_halo_updates, & - "If true, optional arguments may be used to specify the \n"//& - "The width of the halos that are updated with each call.", & + "If true, optional arguments may be used to specify the "//& + "the width of the halos that are updated with each call.", & default=.true., layoutParam=.true.) nihalo_dflt = 4 ; njhalo_dflt = 4 @@ -1327,24 +1327,24 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & if (present(NJHALO)) njhalo_dflt = NJHALO call log_param(param_file, mdl, "!STATIC_MEMORY_", is_static, & - "If STATIC_MEMORY_ is defined, the principle variables \n"//& - "will have sizes that are statically determined at \n"//& - "compile time. Otherwise the sizes are not determined \n"//& - "until run time. The STATIC option is substantially \n"//& - "faster, but does not allow the PE count to be changed \n"//& + "If STATIC_MEMORY_ is defined, the principle variables "//& + "will have sizes that are statically determined at "//& + "compile time. Otherwise the sizes are not determined "//& + "until run time. The STATIC option is substantially "//& + "faster, but does not allow the PE count to be changed "//& "at run time. This can only be set at compile time.",& layoutParam=.true.) call get_param(param_file, mdl, trim(nihalo_nm), MOM_dom%nihalo, & - "The number of halo points on each side in the \n"//& - "x-direction. With STATIC_MEMORY_ this is set as NIHALO_ \n"//& - "in "//trim(inc_nm)//" at compile time; without STATIC_MEMORY_ \n"//& + "The number of halo points on each side in the "//& + "x-direction. With STATIC_MEMORY_ this is set as NIHALO_ "//& + "in "//trim(inc_nm)//" at compile time; without STATIC_MEMORY_ "//& "the default is NIHALO_ in "//trim(inc_nm)//" (if defined) or 2.", & default=4, static_value=nihalo_dflt, layoutParam=.true.) call get_param(param_file, mdl, trim(njhalo_nm), MOM_dom%njhalo, & - "The number of halo points on each side in the \n"//& - "y-direction. With STATIC_MEMORY_ this is set as NJHALO_ \n"//& - "in "//trim(inc_nm)//" at compile time; without STATIC_MEMORY_ \n"//& + "The number of halo points on each side in the "//& + "y-direction. With STATIC_MEMORY_ this is set as NJHALO_ "//& + "in "//trim(inc_nm)//" at compile time; without STATIC_MEMORY_ "//& "the default is NJHALO_ in "//trim(inc_nm)//" (if defined) or 2.", & default=4, static_value=njhalo_dflt, layoutParam=.true.) if (present(min_halo)) then @@ -1357,13 +1357,13 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & endif if (is_static) then call get_param(param_file, mdl, "NIGLOBAL", MOM_dom%niglobal, & - "The total number of thickness grid points in the \n"//& - "x-direction in the physical domain. With STATIC_MEMORY_ \n"//& + "The total number of thickness grid points in the "//& + "x-direction in the physical domain. With STATIC_MEMORY_ "//& "this is set in "//trim(inc_nm)//" at compile time.", & static_value=NIGLOBAL) call get_param(param_file, mdl, "NJGLOBAL", MOM_dom%njglobal, & - "The total number of thickness grid points in the \n"//& - "y-direction in the physical domain. With STATIC_MEMORY_ \n"//& + "The total number of thickness grid points in the "//& + "y-direction in the physical domain. With STATIC_MEMORY_ "//& "this is set in "//trim(inc_nm)//" at compile time.", & static_value=NJGLOBAL) if (MOM_dom%niglobal /= NIGLOBAL) call MOM_error(FATAL,"MOM_domains_init: " // & @@ -1379,13 +1379,13 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & endif else call get_param(param_file, mdl, "NIGLOBAL", MOM_dom%niglobal, & - "The total number of thickness grid points in the \n"//& - "x-direction in the physical domain. With STATIC_MEMORY_ \n"//& + "The total number of thickness grid points in the "//& + "x-direction in the physical domain. With STATIC_MEMORY_ "//& "this is set in "//trim(inc_nm)//" at compile time.", & fail_if_missing=.true.) call get_param(param_file, mdl, "NJGLOBAL", MOM_dom%njglobal, & - "The total number of thickness grid points in the \n"//& - "y-direction in the physical domain. With STATIC_MEMORY_ \n"//& + "The total number of thickness grid points in the "//& + "y-direction in the physical domain. With STATIC_MEMORY_ "//& "this is set in "//trim(inc_nm)//" at compile time.", & fail_if_missing=.true.) endif @@ -1397,15 +1397,15 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & inputdir = slasher(inputdir) call get_param(param_file, mdl, trim(masktable_nm), mask_table, & - "A text file to specify n_mask, layout and mask_list. \n"//& - "This feature masks out processors that contain only land points. \n"//& - "The first line of mask_table is the number of regions to be masked out.\n"//& - "The second line is the layout of the model and must be \n"//& - "consistent with the actual model layout.\n"//& - "The following (n_mask) lines give the logical positions \n"//& - "of the processors that are masked out. The mask_table \n"//& - "can be created by tools like check_mask. The \n"//& - "following example of mask_table masks out 2 processors, \n"//& + "A text file to specify n_mask, layout and mask_list. "//& + "This feature masks out processors that contain only land points. "//& + "The first line of mask_table is the number of regions to be masked out. "//& + "The second line is the layout of the model and must be "//& + "consistent with the actual model layout. "//& + "The following (n_mask) lines give the logical positions "//& + "of the processors that are masked out. The mask_table "//& + "can be created by tools like check_mask. The "//& + "following example of mask_table masks out 2 processors, "//& "(1,2) and (3,6), out of the 24 in a 4x6 layout: \n"//& " 2\n 4,6\n 1,2\n 3,6\n", default="MOM_mask_table", & layoutParam=.true.) @@ -1416,7 +1416,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & layout(1) = NIPROC ; layout(2) = NJPROC else call get_param(param_file, mdl, trim(layout_nm), layout, & - "The processor layout to be used, or 0, 0 to automatically \n"//& + "The processor layout to be used, or 0, 0 to automatically "//& "set the layout based on the number of processors.", default=0, & do_not_log=.true.) call get_param(param_file, mdl, trim(niproc_nm), nip_parsed, & @@ -1455,11 +1455,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & endif endif call log_param(param_file, mdl, trim(niproc_nm), layout(1), & - "The number of processors in the x-direction. With \n"//& + "The number of processors in the x-direction. With "//& "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(njproc_nm), layout(2), & - "The number of processors in the y-direction. With \n"//& + "The number of processors in the y-direction. With "//& "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(layout_nm), layout, & @@ -1484,7 +1484,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & ! number of PEs in each direction. io_layout(:) = (/ 1, 1 /) call get_param(param_file, mdl, trim(io_layout_nm), io_layout, & - "The processor layout to be used, or 0,0 to automatically \n"//& + "The processor layout to be used, or 0,0 to automatically "//& "set the io_layout to be the same as the layout.", default=1, & layoutParam=.true.) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 5c80fb9d51..1d1e153ab9 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -275,26 +275,26 @@ subroutine close_param_file(CS, quiet_close, component) "If true, all log messages are also sent to stdout.", & default=log_to_stdout_default) call log_param(CS, mdl, "REPORT_UNUSED_PARAMS", CS%report_unused, & - "If true, report any parameter lines that are not used \n"//& + "If true, report any parameter lines that are not used "//& "in the run.", default=report_unused_default, & debuggingParam=.true.) call log_param(CS, mdl, "FATAL_UNUSED_PARAMS", CS%unused_params_fatal, & - "If true, kill the run if there are any unused \n"//& + "If true, kill the run if there are any unused "//& "parameters.", default=unused_params_fatal_default, & debuggingParam=.true.) docfile_default = "MOM_parameter_doc" if (present(component)) docfile_default = trim(component)//"_parameter_doc" call log_param(CS, mdl, "DOCUMENT_FILE", CS%doc_file, & - "The basename for files where run-time parameters, their\n"//& - "settings, units and defaults are documented. Blank will\n"//& + "The basename for files where run-time parameters, their "//& + "settings, units and defaults are documented. Blank will "//& "disable all parameter documentation.", default=docfile_default) if (len_trim(CS%doc_file) > 0) then call log_param(CS, mdl, "COMPLETE_DOCUMENTATION", CS%complete_doc, & - "If true, all run-time parameters are\n"//& + "If true, all run-time parameters are "//& "documented in "//trim(CS%doc_file)//& ".all .", default=complete_doc_default) call log_param(CS, mdl, "MINIMAL_DOCUMENTATION", CS%minimal_doc, & - "If true, non-default run-time parameters are\n"//& + "If true, non-default run-time parameters are "//& "documented in "//trim(CS%doc_file)//& ".short .", default=minimal_doc_default) endif diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 9f1b645604..c3819fc865 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1439,7 +1439,7 @@ subroutine restart_init(param_file, CS, restart_root) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", & CS%parallel_restartfiles, & - "If true, each processor writes its own restart file, \n"//& + "If true, each processor writes its own restart file, "//& "otherwise a single restart file is generated", & default=.false.) @@ -1451,16 +1451,16 @@ subroutine restart_init(param_file, CS, restart_root) "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 \n"//& + "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) call get_param(param_file, mdl, "RESTART_CHECKSUMS_REQUIRED", CS%checksum_required, & - "If true, require the restart checksums to match and error out otherwise. \n"//& - "Users may want to avoid this comparison if for example the restarts are \n"//& - "made from a run with a different mask_table than the current run, \n"//& + "If true, require the restart checksums to match and error out otherwise. "//& + "Users may want to avoid this comparison if for example the restarts are "//& + "made from a run with a different mask_table than the current run, "//& "in which case the checksums will not match and cause crash.",& default=.true.) diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index 60b07c1fbd..ca174025bf 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -58,15 +58,15 @@ subroutine unit_scaling_init( param_file, US ) call log_version(param_file, mdl, version, & "Parameters for doing unit scaling of variables.") call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & - "An integer power of 2 that is used to rescale the model's \n"//& + "An integer power of 2 that is used to rescale the model's "//& "intenal units of depths and heights. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) call get_param(param_file, mdl, "L_RESCALE_POWER", L_power, & - "An integer power of 2 that is used to rescale the model's \n"//& + "An integer power of 2 that is used to rescale the model's "//& "intenal units of lateral distances. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) call get_param(param_file, mdl, "T_RESCALE_POWER", T_power, & - "An integer power of 2 that is used to rescale the model's \n"//& + "An integer power of 2 that is used to rescale the model's "//& "intenal units of time. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index c85e3ecb7b..7a2fb36608 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -73,13 +73,13 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, 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, "MAXCPU", CS%maxcpu, & - "The maximum amount of cpu time per processor for which \n"//& - "MOM should run before saving a restart file and \n"//& - "quitting with a return value that indicates that a \n"//& - "further run is required to complete the simulation. \n"//& - "If automatic restarts are not desired, use a negative \n"//& - "value for MAXCPU. MAXCPU has units of wall-clock \n"//& - "seconds, so the actual CPU time used is larger by a \n"//& + "The maximum amount of cpu time per processor for which "//& + "MOM should run before saving a restart file and "//& + "quitting with a return value that indicates that a "//& + "further run is required to complete the simulation. "//& + "If automatic restarts are not desired, use a negative "//& + "value for MAXCPU. MAXCPU has units of wall-clock "//& + "seconds, so the actual CPU time used is larger by a "//& "factor of the number of processors used.", & units="wall-clock seconds", default=-1.0) call get_param(param_file, mdl, "CPU_TIME_FILE", CS%CPUfile, & diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a10a0e55d6..5020a4cbe7 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1170,15 +1170,15 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl default=.false.) if (shelf_mass_is_dynamic) then call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", CS%override_shelf_movement, & - "If true, user provided code specifies the ice-shelf \n"//& + "If true, user provided code specifies the ice-shelf "//& "movement instead of the dynamic ice model.", default=.false.) CS%active_shelf_dynamics = .not.CS%override_shelf_movement call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & - "If true, regularize the floatation condition at the \n"//& + "If true, regularize the floatation condition at the "//& "grounding line as in Goldberg Holland Schoof 2009.", default=.false.) call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & - "If true, let the floatation condition be determined by \n"//& - "ocean column thickness. This means that update_OD_ffrac \n"//& + "If true, let the floatation condition be determined by "//& + "ocean column thickness. This means that update_OD_ffrac "//& "will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", & default=.false., do_not_log=CS%GL_regularize) if (CS%GL_regularize) CS%GL_couple = .false. @@ -1188,24 +1188,24 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "If true, use a thermodynamically interactive ice shelf.", & default=.false.) call get_param(param_file, mdl, "SHELF_THREE_EQN", CS%threeeq, & - "If true, use the three equation expression of \n"//& - "consistency to calculate the fluxes at the ice-ocean \n"//& + "If true, use the three equation expression of "//& + "consistency to calculate the fluxes at the ice-ocean "//& "interface.", default=.true.) call get_param(param_file, mdl, "SHELF_INSULATOR", CS%insulator, & - "If true, the ice shelf is a perfect insulatior \n"//& + "If true, the ice shelf is a perfect insulatior "//& "(no conduction).", default=.false.) call get_param(param_file, mdl, "MELTING_CUTOFF_DEPTH", CS%cutoff_depth, & - "Depth above which the melt is set to zero (it must be >= 0) \n"//& + "Depth above which the melt is set to zero (it must be >= 0) "//& "Default value won't affect the solution.", default=0.0) if (CS%cutoff_depth < 0.) & call MOM_error(WARNING,"Initialize_ice_shelf: MELTING_CUTOFF_DEPTH must be >= 0.") call get_param(param_file, mdl, "CONST_SEA_LEVEL", CS%constant_sea_level, & - "If true, apply evaporative, heat and salt fluxes in \n"//& - "the sponge region. This will avoid a large increase \n"//& - "in sea level. This option is needed for some of the \n"//& - "ISOMIP+ experiments (Ocean3 and Ocean4). \n"//& - "IMPORTANT: it is not currently possible to do \n"//& + "If true, apply evaporative, heat and salt fluxes in "//& + "the sponge region. This will avoid a large increase "//& + "in sea level. This option is needed for some of the "//& + "ISOMIP+ experiments (Ocean3 and Ocean4). "//& + "IMPORTANT: it is not currently possible to do "//& "prefect restarts using this flag.", default=.false.) call get_param(param_file, mdl, "ISOMIP_S_SUR_SPONGE", & @@ -1217,8 +1217,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl default=-1.9, do_not_log=.true.) call get_param(param_file, mdl, "SHELF_3EQ_GAMMA", CS%const_gamma, & - "If true, user specifies a constant nondimensional heat-transfer coefficient \n"//& - "(GAMMA_T_3EQ), from which the salt-transfer coefficient is then computed \n"//& + "If true, user specifies a constant nondimensional heat-transfer coefficient "//& + "(GAMMA_T_3EQ), from which the salt-transfer coefficient is then computed "//& " as GAMMA_T_3EQ/35. This is used with SHELF_THREE_EQN.", default=.false.) if (CS%const_gamma) call get_param(param_file, mdl, "SHELF_3EQ_GAMMA_T", CS%Gamma_T_3EQ, & "Nondimensional heat-transfer coefficient.",default=2.2E-2, & @@ -1230,19 +1230,19 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (CS%threeeq) & 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) \n "//& - "is computed from a quadratic equation. Otherwise, the previous \n"//& + "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.) if (CS%find_salt_root) then ! read liquidus coeffs. call get_param(param_file, mdl, "TFREEZE_S0_P0",CS%lambda1, & - "this is the freezing potential temperature at \n"//& + "this is the freezing potential temperature at "//& "S=0, P=0.", units="degC", default=0.0, do_not_log=.true.) call get_param(param_file, mdl, "DTFREEZE_DS",CS%lambda1, & - "this is the derivative of the freezing potential \n"//& + "this is the derivative of the freezing potential "//& "temperature with salinity.", & units="degC psu-1", default=-0.054, do_not_log=.true.) call get_param(param_file, mdl, "DTFREEZE_DP",CS%lambda3, & - "this is the derivative of the freezing potential \n"//& + "this is the derivative of the freezing potential "//& "temperature with pressure.", & units="degC Pa-1", default=0.0, do_not_log=.true.) @@ -1250,7 +1250,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (.not.CS%threeeq) & call get_param(param_file, mdl, "SHELF_2EQ_GAMMA_T", CS%gamma_t, & - "If SHELF_THREE_EQN is false, this the fixed turbulent \n"//& + "If SHELF_THREE_EQN is false, this the fixed turbulent "//& "exchange velocity at the ice-ocean interface.", & units="m s-1", fail_if_missing=.true.) @@ -1261,9 +1261,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "The heat capacity of sea water.", units="J kg-1 K-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) !### MAKE THIS A SEPARATE PARAMETER. call get_param(param_file, mdl, "C_P_ICE", CS%Cp_ice, & @@ -1271,13 +1271,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl default=2.10e3) call get_param(param_file, mdl, "ICE_SHELF_FLUX_FACTOR", CS%flux_factor, & - "Non-dimensional factor applied to shelf thermodynamic \n"//& + "Non-dimensional factor applied to shelf thermodynamic "//& "fluxes.", units="none", default=1.0) call get_param(param_file, mdl, "KV_ICE", CS%kv_ice, & "The viscosity of the ice.", units="m2 s-1", default=1.0e10) call get_param(param_file, mdl, "KV_MOLECULAR", CS%kv_molec, & - "The molecular kinimatic viscosity of sea water at the \n"//& + "The molecular kinimatic viscosity of sea water at the "//& "freezing temperature.", units="m2 s-1", default=1.95e-6) call get_param(param_file, mdl, "ICE_SHELF_SALINITY", CS%Salin_ice, & "The salinity of the ice inside the ice shelf.", units="psu", & @@ -1286,17 +1286,17 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "The temperature at the center of the ice shelf.", & units = "degC", default=-15.0) call get_param(param_file, mdl, "KD_SALT_MOLECULAR", CS%kd_molec_salt, & - "The molecular diffusivity of salt in sea water at the \n"//& + "The molecular diffusivity of salt in sea water at the "//& "freezing point.", units="m2 s-1", default=8.02e-10) call get_param(param_file, mdl, "KD_TEMP_MOLECULAR", CS%kd_molec_temp, & - "The molecular diffusivity of heat in sea water at the \n"//& + "The molecular diffusivity of heat in sea water at the "//& "freezing point.", units="m2 s-1", default=1.41e-7) call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & "avg ocean density used in floatation cond", & units="kg m-3", default=1035.) call get_param(param_file, mdl, "DT_FORCING", CS%time_step, & - "The time step for changing forcing, coupling with other \n"//& - "components, or potentially writing certain diagnostics. \n"//& + "The time step for changing forcing, coupling with other "//& + "components, or potentially writing certain diagnostics. "//& "The default value is given by DT.", units="s", default=0.0) call get_param(param_file, mdl, "COL_THICK_MELT_THRESHOLD", CS%col_thick_melt_threshold, & @@ -1304,14 +1304,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl default=0.0) call get_param(param_file, mdl, "READ_TIDEAMP", read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) call safe_alloc_ptr(CS%utide,isd,ied,jsd,jed) ; CS%utide(:,:) = 0.0 if (read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes.", & default="tideamp.nc") call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") @@ -1353,15 +1353,15 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "The minimum value of ustar under ice sheves.", & units="m s-1", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, & - "CDRAG is the drag coefficient relating the magnitude of \n"//& + "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the surface stress.", units="nondim", & default=0.003) CS%cdrag = cdrag if (CS%ustar_bg <= 0.0) then call get_param(param_file, mdl, "DRAG_BG_VEL_SHELF", drag_bg_vel, & - "DRAG_BG_VEL is either the assumed bottom velocity (with \n"//& - "LINEAR_DRAG) or an unresolved velocity that is \n"//& - "combined with the resolved velocity to estimate the \n"//& + "DRAG_BG_VEL is either the assumed bottom velocity (with "//& + "LINEAR_DRAG) or an unresolved velocity that is "//& + "combined with the resolved velocity to estimate the "//& "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z) if (CS%cdrag*drag_bg_vel > 0.0) CS%ustar_bg = sqrt(CS%cdrag)*drag_bg_vel endif @@ -1536,7 +1536,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "If true, save the ice shelf initial conditions.", & default=.false.) if (save_IC) call get_param(param_file, mdl, "SHELF_IC_OUTPUT_FILE", IC_file,& - "The name-root of the output file for the ice shelf \n"//& + "The name-root of the output file for the ice shelf "//& "initial conditions.", default="MOM_Shelf_IC") if (save_IC .and. .not.((dirs%input_filename(1:1) == 'r') .and. & @@ -1606,7 +1606,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) new_sim_2 = .true. ; if (present(new_sim)) new_sim_2 = new_sim call get_param(param_file, mdl, "ICE_SHELF_CONFIG", config, & - "A string that specifies how the ice shelf is \n"//& + "A string that specifies how the ice shelf is "//& "initialized. Valid options include:\n"//& " \tfile\t Read from a file.\n"//& " \tzero\t Set shelf mass to 0 everywhere.\n"//& @@ -1622,8 +1622,8 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) inputdir = slasher(inputdir) call get_param(param_file, mdl, "SHELF_FILE", shelf_file, & - "If DYNAMIC_SHELF_MASS = True, OVERRIDE_SHELF_MOVEMENT = True \n"//& - "and ICE_SHELF_MASS_FROM_FILE = True, this is the file from \n"//& + "If DYNAMIC_SHELF_MASS = True, OVERRIDE_SHELF_MOVEMENT = True "//& + "and ICE_SHELF_MASS_FROM_FILE = True, this is the file from "//& "which to read the shelf mass and area.", & default="shelf_mass.nc") call get_param(param_file, mdl, "SHELF_MASS_VAR", shelf_mass_var, & diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index b53021bbb2..b1c970871b 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -225,7 +225,7 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) default=.false., do_not_log=.true.) if (shelf_mass_is_dynamic) then call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & - "If true, user provided code specifies the ice-shelf \n"//& + "If true, user provided code specifies the ice-shelf "//& "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) active_shelf_dynamics = .not.override_shelf_movement endif @@ -312,29 +312,29 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ override_shelf_movement = .false. ; active_shelf_dynamics = .false. if (shelf_mass_is_dynamic) then call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & - "If true, user provided code specifies the ice-shelf \n"//& + "If true, user provided code specifies the ice-shelf "//& "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) active_shelf_dynamics = .not.override_shelf_movement call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & - "If true, regularize the floatation condition at the \n"//& + "If true, regularize the floatation condition at the "//& "grounding line as in Goldberg Holland Schoof 2009.", default=.false.) call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", CS%n_sub_regularize, & - "The number of sub-partitions of each cell over which to \n"//& - "integrate for the interpolated grounding line. Each cell \n"//& - "is divided into NxN equally-sized rectangles, over which the \n"//& + "The number of sub-partitions of each cell over which to "//& + "integrate for the interpolated grounding line. Each cell "//& + "is divided into NxN equally-sized rectangles, over which the "//& "basal contribution is integrated by iterative quadrature.", & default=0) call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & - "If true, let the floatation condition be determined by \n"//& - "ocean column thickness. This means that update_OD_ffrac \n"//& + "If true, let the floatation condition be determined by "//& + "ocean column thickness. This means that update_OD_ffrac "//& "will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", & default=.false., do_not_log=CS%GL_regularize) if (CS%GL_regularize) CS%GL_couple = .false. if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, & "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & - "A factor used to limit timestep as CFL_FACTOR * min (\Delta x / u). \n"// & + "A factor used to limit timestep as CFL_FACTOR * min (\Delta x / u). "//& "This is only used with an ice-only model.", default=0.25) endif call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & @@ -372,14 +372,14 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & "max iteratiions in CG solver", default=2000) call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & - "min ocean thickness to consider ice *floating*; \n"// & + "min ocean thickness to consider ice *floating*; "//& "will only be important with use of tides", & units="m", default=1.e-3, scale=US%m_to_Z) call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & - "Choose whether nonlin error in vel solve is based on nonlinear \n"// & + "Choose whether nonlin error in vel solve is based on nonlinear "//& "residual (1) or relative change since last iteration (2)", default=1) call get_param(param_file, mdl, "SHELF_DYN_REPRODUCING_SUMS", CS%use_reproducing_sums, & - "If true, use the reproducing extended-fixed-point sums in \n"//& + "If true, use the reproducing extended-fixed-point sums in "//& "the ice shelf dynamics solvers.", default=.true.) call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 945b634e91..bc00ac61a9 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -42,7 +42,7 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, PF) character(len=200) :: config call get_param(PF, mdl, "ICE_PROFILE_CONFIG", config, & - "This specifies how the initial ice profile is specified. \n"//& + "This specifies how the initial ice profile is specified. "//& "Valid values are: CHANNEL, FILE, and USER.", & fail_if_missing=.true.) @@ -180,9 +180,9 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, call get_param(PF, mdl, "SHELF_EDGE_POS_0", edge_pos, & units="axis_units", default=0.0) ! call get_param(param_file, mdl, "RHO_0", Rho_ocean, & -! "The mean ocean density used with BOUSSINESQ true to \n"//& -! "calculate accelerations and the mass for conservation \n"//& -! "properties, or with BOUSSINSEQ false to convert some \n"//& +! "The mean ocean density used with BOUSSINESQ true to "//& +! "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, scale=US%Z_to_m) @@ -272,11 +272,11 @@ end subroutine initialize_ice_thickness_channel ! logical flux_bdry ! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & -! "This specifies how the ice domain boundary is specified. \n"//& +! "This specifies how the ice domain boundary is specified. "//& ! "valid values include CHANNEL, FILE and USER.", & ! fail_if_missing=.true.) ! call get_param(PF, mdl, "ICE_BOUNDARY_FLUX_CONDITION", flux_bdry, & -! "This specifies whether mass input is a dirichlet or \n"//& +! "This specifies whether mass input is a dirichlet or "//& ! "flux condition", default=.true.) ! select case ( trim(config) ) diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index d4e83561a7..5505154d23 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -185,8 +185,7 @@ subroutine marine_ice_init(Time, G, param_file, diag, CS) character(len=40) :: mdl = "MOM_marine_ice" ! This module's name. if (associated(CS)) then - call MOM_error(WARNING, "marine_ice_init called with an "// & - "associated control structure.") + call MOM_error(WARNING, "marine_ice_init called with an associated control structure.") return else ; allocate(CS) ; endif @@ -200,8 +199,8 @@ subroutine marine_ice_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", CS%berg_area_threshold, & - "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& - "below berg are set to zero. Not applied for negative \n"//& + "Fraction of grid cell which iceberg must occupy, so that fluxes "//& + "below berg are set to zero. Not applied for negative "//& "values.", units="non-dim", default=-1.0) end subroutine marine_ice_init diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 2829f712e0..ec2787bae3 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -77,9 +77,9 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, if (CS%first_call) call write_user_log(param_file) CS%first_call = .false. call get_param(param_file, mdl, "RHO_0", CS%Rho_ocean, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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, scale=US%Z_to_m) call get_param(param_file, mdl, "SHELF_MAX_DRAFT", CS%max_draft, & diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 8899627cc7..d497a7828e 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -275,7 +275,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & "The reduced gravity at the free surface.", units="m s-2", & default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & - "The file from which the coordinate temperatures and \n"//& + "The file from which the coordinate temperatures and "//& "salinities are read.", fail_if_missing=.true.) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") @@ -330,25 +330,25 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "T_REF", T_Ref, & "The default initial temperatures.", units="degC", default=10.0) call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_Light, & - "The initial temperature of the lightest layer when \n"//& + "The initial temperature of the lightest layer when "//& "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref) call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_Dense, & - "The initial temperature of the densest layer when \n"//& + "The initial temperature of the densest layer when "//& "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref) call get_param(param_file, mdl, "S_REF", S_Ref, & "The default initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_Light, & - "The initial lightest salinities when COORD_CONFIG \n"//& + "The initial lightest salinities when COORD_CONFIG "//& "is set to ts_range.", default = S_Ref, units="PSU") call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_Dense, & - "The initial densest salinities when COORD_CONFIG \n"//& + "The initial densest salinities when COORD_CONFIG "//& "is set to ts_range.", default = S_Ref, units="PSU") call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & - "The ratio of density space resolution in the densest \n"//& - "part of the range to that in the lightest part of the \n"//& - "range when COORD_CONFIG is set to ts_range. Values \n"//& + "The ratio of density space resolution in the densest "//& + "part of the range to that in the lightest part of the "//& + "range when COORD_CONFIG is set to ts_range. Values "//& "greater than 1 increase the resolution of the denser water.",& default=1.0, units="nondim") @@ -408,7 +408,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) "The file from which the coordinate densities are read.", & fail_if_missing=.true.) call get_param(param_file, mdl, "COORD_VAR", coord_var, & - "The variable in COORD_FILE that is to be used for the \n"//& + "The variable in COORD_FILE that is to be used for the "//& "coordinate densities.", default="Layer") filename = trim(inputdir)//trim(coord_file) call log_param(param_file, mdl, "INPUTDIR/COORD_FILE", filename) @@ -449,11 +449,11 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & - "The reference potential density used for the surface \n"// & - "interface.", units="kg m-3", default=GV%Rho0) + "The reference potential density used for the surface interface.", & + units="kg m-3", default=GV%Rho0) call get_param(param_file, mdl, "DENSITY_RANGE", Rlay_range, & - "The range of reference potential densities across \n"// & - "all interfaces.", units="kg m-3", default=2.0) + "The range of reference potential densities across all interfaces.", & + units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index f51676bd1b..71d9c4f90b 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -134,7 +134,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! This call sets the topography at velocity points. if (G%bathymetry_at_vel) then call get_param(PF, mdl, "VELOCITY_DEPTH_CONFIG", config, & - "A string that determines how the topography is set at \n"//& + "A string that determines how the topography is set at "//& "velocity points. This may be 'min' or 'max'.", & default="max") select case ( trim(config) ) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 3da13a3063..305087dc44 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -72,7 +72,7 @@ subroutine set_grid_metrics(G, param_file, US) 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, & - "A character string that determines the method for \n"//& + "A character string that determines the method for "//& "defining the horizontal grid. Current options are: \n"//& " \t mosaic - read the grid from a mosaic (supergrid) \n"//& " \t file set by GRID_FILE.\n"//& @@ -202,7 +202,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) call get_param(param_file, mdl, "USE_TRIPOLAR_GEOLONB_BUG", lon_bug, & - "If true, use older code that incorrectly sets the longitude \n"//& + "If true, use older code that incorrectly sets the longitude "//& "in some points along the tripolar fold to be off by 360 degrees.", & default=.true.) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") @@ -443,14 +443,14 @@ subroutine set_grid_metrics_cartesian(G, param_file) " \t degrees - degrees of latitude and longitude \n"//& " \t m - meters \n \t k - kilometers", default="degrees") call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & - "The southern latitude of the domain or the equivalent \n"//& + "The southern latitude of the domain or the equivalent "//& "starting value for the y-axis.", units=units_temp, & fail_if_missing=.true.) call get_param(param_file, mdl, "LENLAT", G%len_lat, & "The latitudinal or y-direction length of the domain.", & units=units_temp, fail_if_missing=.true.) call get_param(param_file, mdl, "WESTLON", G%west_lon, & - "The western longitude of the domain or the equivalent \n"//& + "The western longitude of the domain or the equivalent "//& "starting value for the x-axis.", units=units_temp, & default=0.0) call get_param(param_file, mdl, "LENLON", G%len_lon, & @@ -746,24 +746,24 @@ subroutine set_grid_metrics_mercator(G, param_file) G%west_lon = GP%west_lon ; G%len_lon = GP%len_lon G%Rad_Earth = GP%Rad_Earth call get_param(param_file, mdl, "ISOTROPIC", GP%isotropic, & - "If true, an isotropic grid on a sphere (also known as \n"//& - "a Mercator grid) is used. With an isotropic grid, the \n"//& - "meridional extent of the domain (LENLAT), the zonal \n"//& - "extent (LENLON), and the number of grid points in each \n"//& - "direction are _not_ independent. In MOM the meridional \n"//& - "extent is determined to fit the zonal extent and the \n"//& + "If true, an isotropic grid on a sphere (also known as "//& + "a Mercator grid) is used. With an isotropic grid, the "//& + "meridional extent of the domain (LENLAT), the zonal "//& + "extent (LENLON), and the number of grid points in each "//& + "direction are _not_ independent. In MOM the meridional "//& + "extent is determined to fit the zonal extent and the "//& "number of grid points, while grid is perfectly isotropic.", & default=.false.) call get_param(param_file, mdl, "EQUATOR_REFERENCE", GP%equator_reference, & - "If true, the grid is defined to have the equator at the \n"//& + "If true, the grid is defined to have the equator at the "//& "nearest q- or h- grid point to (-LOWLAT*NJGLOBAL/LENLAT).", & default=.true.) call get_param(param_file, mdl, "LAT_ENHANCE_FACTOR", GP%Lat_enhance_factor, & - "The amount by which the meridional resolution is \n"//& + "The amount by which the meridional resolution is "//& "enhanced within LAT_EQ_ENHANCE of the equator.", & units="nondim", default=1.0) call get_param(param_file, mdl, "LAT_EQ_ENHANCE", GP%Lat_eq_enhance, & - "The latitude range to the north and south of the equator \n"//& + "The latitude range to the north and south of the equator "//& "over which the resolution is enhanced.", units="degrees", & default=0.0) @@ -1236,13 +1236,13 @@ 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 call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "If MASKING_DEPTH is unspecified, then anything shallower than\n"//& - "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& - "If MASKING_DEPTH is specified, then all depths shallower than\n"//& + "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) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & - "The depth below which to mask points as land points, for which all\n"//& + "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & units="m", default=-9999.0, scale=m_to_Z_scale) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 2f9b1cefcc..42e99f2ef6 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -72,7 +72,7 @@ subroutine MOM_initialize_rotation(f, G, PF, US) "This specifies how the Coriolis parameter is specified: \n"//& " \t 2omegasinlat - Use twice the planetary rotation rate \n"//& " \t\t times the sine of latitude.\n"//& - " \t betaplane - Use a beta-plane or f-plane. \n"//& + " \t betaplane - Use a beta-plane or f-plane.\n"//& " \t USER - call a user modified routine.", & default="2omegasinlat") select case (trim(config)) @@ -349,7 +349,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! 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 \n"//& + "The exponential decay scale used in defining some of "//& "the named topographies.", units="m", default=400000.0) endif @@ -426,9 +426,9 @@ subroutine limit_topography(D, G, param_file, max_depth, US) 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\n"//& - "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& - "If MASKING_DEPTH is specified, then all depths shallower than\n"//& + "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) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & @@ -511,10 +511,10 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s call get_param(param_file, mdl, "F_0", f_0, & - "The reference value of the Coriolis parameter with the \n"//& + "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 \n"//& + "The northward gradient of the Coriolis parameter with "//& "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s) call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") @@ -554,8 +554,8 @@ subroutine initialize_grid_rotation_angle(G, PF) integer :: i, j, m, n call get_param(PF, mdl, "GRID_ROTATION_ANGLE_BUGS", use_bugs, & - "If true, use an older algorithm to calculate the sine and \n"//& - "cosines needed rotate between grid-oriented directions and \n"//& + "If true, use an older algorithm to calculate the sine and "//& + "cosines needed rotate between grid-oriented directions and "//& "true north and east. Differences arise at the tripolar fold.", & default=.True.) @@ -842,7 +842,7 @@ subroutine reset_face_lengths_list(G, param_file, US) filename = trim(inputdir)//trim(chan_file) call log_param(param_file, mdl, "INPUTDIR/CHANNEL_LIST_FILE", filename) call get_param(param_file, mdl, "CHANNEL_LIST_360_LON_CHECK", check_360, & - "If true, the channel configuration list works for any \n"//& + "If true, the channel configuration list works for any "//& "longitudes in the range of -360 to 360.", default=.true.) if (is_root_pe()) then @@ -1241,7 +1241,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) out_q(:,:) = 0.0 call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", multiple_files, & - "If true, each processor writes its own restart file, \n"//& + "If true, each processor writes its own restart file, "//& "otherwise a single restart file is generated", & default=.false.) file_threading = SINGLE_FILE diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6adf12028f..76f4cbc685 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -229,9 +229,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! 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, \n"//& - "and salinities from a Z-space file on a latitude- \n"//& - "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. @@ -243,7 +243,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & else ! Initialize thickness, h. call get_param(PF, mdl, "THICKNESS_CONFIG", config, & - "A string that determines how the initial layer \n"//& + "A string that determines how the initial layer "//& "thicknesses are specified for a new run: \n"//& " \t file - read interface heights from the file specified \n"//& " \t thickness_file - read thicknesses from the file specified \n"//& @@ -325,7 +325,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! Initialize temperature and salinity (T and S). if ( use_temperature ) then call get_param(PF, mdl, "TS_CONFIG", config, & - "A string that determines how the initial tempertures \n"//& + "A string that determines how the initial tempertures "//& "and salinities are specified for a new run: \n"//& " \t file - read velocities from the file specified \n"//& " \t\t by (TS_FILE). \n"//& @@ -392,7 +392,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! Initialize velocity components, u and v call get_param(PF, mdl, "VELOCITY_CONFIG", config, & - "A string that determines how the initial velocities \n"//& + "A string that determines how the initial velocities "//& "are specified for a new run: \n"//& " \t file - read velocities from the file specified \n"//& " \t\t by (VELOCITY_FILE). \n"//& @@ -431,9 +431,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! Optionally convert the thicknesses from m to kg m-2. This is particularly ! useful in a non-Boussinesq model. call get_param(PF, mdl, "CONVERT_THICKNESS_UNITS", convert, & - "If true, convert the thickness initial conditions from \n"//& - "units of m to kg m-2 or vice versa, depending on whether \n"//& - "BOUSSINESQ is defined. This does not apply if a restart \n"//& + "If true, convert the thickness initial conditions from "//& + "units of m to kg m-2 or vice versa, depending on whether "//& + "BOUSSINESQ is defined. This does not apply if a restart "//& "file is read.", default=.not.GV%Boussinesq, do_not_log=just_read) if (new_sim .and. convert .and. .not.GV%Boussinesq) & @@ -442,12 +442,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! 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 \n"//& + "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\n"//& - "at the depth where the hydrostatic pressure matches the imposed\n"//& + "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: "//& @@ -461,13 +461,13 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! iterations here so the initial grid is consistent with the coordinate if (useALE) then call get_param(PF, mdl, "REGRID_ACCELERATE_INIT", regrid_accelerate, & - "If true, runs REGRID_ACCELERATE_ITERATIONS iterations of the regridding\n"//& - "algorithm to push the initial grid to be consistent with the initial\n"//& + "If true, runs REGRID_ACCELERATE_ITERATIONS iterations of the regridding "//& + "algorithm to push the initial grid to be consistent with the initial "//& "condition. Useful only for state-based and iterative coordinates.", & default=.false., do_not_log=just_read) if (regrid_accelerate) then call get_param(PF, mdl, "REGRID_ACCELERATE_ITERATIONS", regrid_iterations, & - "The number of regridding iterations to perform to generate\n"//& + "The number of regridding iterations to perform to generate "//& "an initial grid that is consistent with the initial conditions.", & default=1, do_not_log=just_read) @@ -513,8 +513,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & endif call get_param(PF, mdl, "SPONGE", use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified via SPONGE_CONFIG.", default=.false.) if ( use_sponge ) then call get_param(PF, mdl, "SPONGE_CONFIG", config, & @@ -554,8 +554,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This controls user code for setting open boundary data if (associated(OBC)) then call get_param(PF, mdl, "OBC_USER_CONFIG", config, & - "A string that sets how the user code is invoked to set open\n"//& - " boundary data: \n"//& + "A string that sets how the user code is invoked to set open boundary data: \n"//& " DOME - specified inflow on northern boundary\n"//& " dyed_channel - supercritical with dye on the inflow boundary\n"//& " dyed_obcs - circle_obcs with dyes on the open boundaries\n"//& @@ -655,8 +654,8 @@ subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thi call MOM_read_data(filename, "h", h(:,:,:), G%Domain, scale=GV%m_to_H) else call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & - "If true, all mass below the bottom removed if the \n"//& - "topography is shallower than the thickness input file \n"//& + "If true, all mass below the bottom removed if the "//& + "topography is shallower than the thickness input file "//& "would indicate.", default=.false., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -854,10 +853,10 @@ subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) 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 \n"//& + "The file from which horizontal mean initial conditions "//& "for interface depths can be read.", fail_if_missing=.true.) call get_param(param_file, mdl, "INTERFACE_IC_VAR", eta_var, & - "The variable name for horizontal mean initial conditions \n"//& + "The variable name for horizontal mean initial conditions "//& "for interface depths relative to mean sea level.", & default="eta") @@ -1029,7 +1028,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) 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 \n"//& + "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into "//& "units of m", units="variable", default=1.0, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1108,7 +1107,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) if (.not.just_read) call log_param(PF, mdl, "!INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) call get_param(PF, mdl, "SURFACE_PRESSURE_SCALE", scale_factor, & - "A scaling factor to convert SURFACE_PRESSURE_VAR from\n"//& + "A scaling factor to convert SURFACE_PRESSURE_VAR from "//& "file SURFACE_PRESSURE_FILE into a surface pressure.", & units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & @@ -1371,7 +1370,7 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) 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\n"// & + "The amplitude of zonal flow from which to scale the "// & "circular stream function [m s-1].", & units="m s-1", default=0., do_not_log=just_read) @@ -1487,7 +1486,7 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_para if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "TS_FILE", ts_file, & - "The file with the reference profiles for temperature \n"//& + "The file with the reference profiles for temperature "//& "and salinity.", fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1551,7 +1550,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref "A reference salinity used in initialization.", units="PSU", & default=35.0, do_not_log=just_read) call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & - "If true, accept the prescribed temperature and fit the \n"//& + "If true, accept the prescribed temperature and fit the "//& "salinity; otherwise take salinity and fit temperature.", & default=.false., do_not_log=just_read) @@ -1724,27 +1723,27 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C "The name of the file with the state to damp toward.", & default=damping_file) call get_param(param_file, mdl, "SPONGE_PTEMP_VAR", potemp_var, & - "The name of the potential temperature variable in \n"//& + "The name of the potential temperature variable in "//& "SPONGE_STATE_FILE.", default="PTEMP") call get_param(param_file, mdl, "SPONGE_SALT_VAR", salin_var, & - "The name of the salinity variable in \n"//& + "The name of the salinity variable in "//& "SPONGE_STATE_FILE.", default="SALT") call get_param(param_file, mdl, "SPONGE_ETA_VAR", eta_var, & - "The name of the interface height variable in \n"//& + "The name of the interface height variable in "//& "SPONGE_STATE_FILE.", default="ETA") call get_param(param_file, mdl, "SPONGE_IDAMP_VAR", Idamp_var, & - "The name of the inverse damping rate variable in \n"//& + "The name of the inverse damping rate variable in "//& "SPONGE_DAMPING_FILE.", default="IDAMP") call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, do_not_log = .true.) call get_param(param_file, mdl, "NEW_SPONGES", new_sponges, & - "Set True if using the newer sponging code which \n"//& + "Set True if using the newer sponging code which "//& "performs on-the-fly regridding in lat-lon-time.",& "of sponge restoring data.", default=.false.) ! if (use_ALE) then ! call get_param(param_file, mdl, "SPONGE_RESTORE_ETA", restore_eta, & -! "If true, then restore the interface positions towards \n"//& +! "If true, then restore the interface positions towards "//& ! "target values (in ALE mode)", default = .false.) ! endif @@ -2024,45 +2023,45 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param call get_param(PF, mdl, "NKBL",nkbl,default=0) call get_param(PF, mdl, "TEMP_SALT_Z_INIT_FILE",filename, & - "The name of the z-space input file used to initialize \n"//& - "temperatures (T) and salinities (S). If T and S are not \n" //& - "in the same file, TEMP_Z_INIT_FILE and SALT_Z_INIT_FILE \n" //& + "The name of the z-space input file used to initialize "//& + "temperatures (T) and salinities (S). If T and S are not "//& + "in the same file, TEMP_Z_INIT_FILE and SALT_Z_INIT_FILE "//& "must be set.",default="temp_salt_z.nc",do_not_log=just_read) call get_param(PF, mdl, "TEMP_Z_INIT_FILE",tfilename, & - "The name of the z-space input file used to initialize \n"//& + "The name of the z-space input file used to initialize "//& "temperatures, only.", default=trim(filename),do_not_log=just_read) call get_param(PF, mdl, "SALT_Z_INIT_FILE",sfilename, & - "The name of the z-space input file used to initialize \n"//& + "The name of the z-space input file used to initialize "//& "temperatures, only.", default=trim(filename),do_not_log=just_read) filename = trim(inputdir)//trim(filename) tfilename = trim(inputdir)//trim(tfilename) sfilename = trim(inputdir)//trim(sfilename) call get_param(PF, mdl, "Z_INIT_FILE_PTEMP_VAR", potemp_var, & - "The name of the potential temperature variable in \n"//& + "The name of the potential temperature variable in "//& "TEMP_Z_INIT_FILE.", default="ptemp",do_not_log=just_read) call get_param(PF, mdl, "Z_INIT_FILE_SALT_VAR", salin_var, & - "The name of the salinity variable in \n"//& + "The name of the salinity variable in "//& "SALT_Z_INIT_FILE.", default="salt",do_not_log=just_read) call get_param(PF, mdl, "Z_INIT_HOMOGENIZE", homogenize, & - "If True, then horizontally homogenize the interpolated \n"//& + "If True, then horizontally homogenize the interpolated "//& "initial conditions.", default=.false., do_not_log=just_read) call get_param(PF, mdl, "Z_INIT_ALE_REMAPPING", useALEremapping, & - "If True, then remap straight to model coordinate from file.",& + "If True, then remap straight to model coordinate from file.", & default=.false., do_not_log=just_read) call get_param(PF, mdl, "Z_INIT_REMAPPING_SCHEME", remappingScheme, & - "The remapping scheme to use if using Z_INIT_ALE_REMAPPING\n"//& + "The remapping scheme to use if using Z_INIT_ALE_REMAPPING "//& "is True.", default="PPM_IH4", do_not_log=just_read) call get_param(PF, mdl, "Z_INIT_REMAP_GENERAL", remap_general, & - "If false, only initializes to z* coordinates.\n"//& + "If false, only initializes to z* coordinates. "//& "If true, allows initialization directly to general coordinates.",& default=.false., do_not_log=just_read) call get_param(PF, mdl, "Z_INIT_REMAP_FULL_COLUMN", remap_full_column, & - "If false, only reconstructs profiles for valid data points.\n"//& - "If true, inserts vanished layers below the valid data.",& + "If false, only reconstructs profiles for valid data points. "//& + "If true, inserts vanished layers below the valid data.", & default=remap_general, do_not_log=just_read) call get_param(PF, mdl, "Z_INIT_REMAP_OLD_ALG", remap_old_alg, & - "If false, uses the preferred remapping algorithm for initialization.\n"//& - "If true, use an older, less robust algorithm for remapping.",& + "If false, uses the preferred remapping algorithm for initialization. "//& + "If true, use an older, less robust algorithm for remapping.", & default=.true., do_not_log=just_read) call get_param(PF, mdl, "ICE_SHELF", use_ice_shelf, default=.false.) if (use_ice_shelf) then @@ -2077,14 +2076,14 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param endif if (.not.useALEremapping) then call get_param(PF, mdl, "ADJUST_THICKNESS", correct_thickness, & - "If true, all mass below the bottom removed if the \n"//& - "topography is shallower than the thickness input file \n"//& + "If true, all mass below the bottom removed if the "//& + "topography is shallower than the thickness input file "//& "would indicate.", default=.false., do_not_log=just_read) call get_param(PF, mdl, "FIT_TO_TARGET_DENSITY_IC", adjust_temperature, & - "If true, all the interior layers are adjusted to \n"//& - "their target densities using mostly temperature \n"//& - "This approach can be problematic, particularly in the \n"//& + "If true, all the interior layers are adjusted to "//& + "their target densities using mostly temperature "//& + "This approach can be problematic, particularly in the "//& "high latitudes.", default=.true., do_not_log=just_read) endif if (just_read) then diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 27511e1593..08fb487bc5 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -103,14 +103,14 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(PF, mdl, "Z_INIT_HOMOGENIZE", homog, & - "If True, then horizontally homogenize the interpolated \n"//& + "If True, then horizontally homogenize the interpolated "//& "initial conditions.", default=.false.) call get_param(PF, mdl, "Z_INIT_ALE_REMAPPING", useALE, & "If True, then remap straight to model coordinate from file.",& default=.true.) call get_param(PF, mdl, "Z_INIT_REMAPPING_SCHEME", remapScheme, & - "The remapping scheme to use if using Z_INIT_ALE_REMAPPING\n"//& - "is True.", default="PLM") + "The remapping scheme to use if using Z_INIT_ALE_REMAPPING is True.", & + default="PLM") ! These are model grid properties, but being applied to the data grid for now. ! need to revisit this (mjh) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 1a9bf92c57..27dde7f69d 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -150,7 +150,7 @@ subroutine init_oda(Time, G, GV, CS) call unit_scaling_init(PF, CS%US) call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, & - "String which determines the data assimilation 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, & "data assimilation frequency in hours") @@ -163,14 +163,14 @@ subroutine init_oda(Time, G, GV, CS) "If true, the domain is meridionally reentrant.", & default=.false.) call get_param(PF,"MOM", "TRIPOLAR_N", CS%tripolar_N, & - "Use tripolar connectivity at the northern edge of the \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", "NIGLOBAL", CS%ni, & - "The total number of thickness grid points in the \n"//& + "The total number of thickness grid points in the "//& "x-direction in the physical domain.") call get_param(PF,"MOM", "NJGLOBAL", CS%nj, & - "The total number of thickness grid points in the \n"//& + "The total number of thickness grid points in the "//& "y-direction in the physical domain.") call get_param(PF, 'MOM', "INPUTDIR", inputdir) inputdir = slasher(inputdir) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index bb463824b1..78427dddf8 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -874,7 +874,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) ! Determine whether this module will be used call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "USE_MEKE", MEKE_init, & - "If true, turns on the MEKE scheme which calculates\n"// & + "If true, turns on the MEKE scheme which calculates "// & "a sub-grid mesoscale eddy kinetic energy budget.", & default=.false.) if (.not. MEKE_init) return @@ -898,56 +898,56 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "The local depth-independent MEKE dissipation rate.", & units="s-1", default=0.0) call get_param(param_file, mdl, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & - "The ratio of the bottom eddy velocity to the column mean\n"//& - "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1\n"//& + "The ratio of the bottom eddy velocity to the column mean "//& + "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 "//& "to account for the surface intensification of MEKE.", & units="nondim", default=0.) call get_param(param_file, mdl, "MEKE_CB", CS%MEKE_Cb, & - "A coefficient in the expression for the ratio of bottom projected\n"//& + "A coefficient in the expression for the ratio of bottom projected "//& "eddy energy and mean column energy (see Jansen et al. 2015).",& units="nondim", default=25.) call get_param(param_file, mdl, "MEKE_MIN_GAMMA2", CS%MEKE_min_gamma, & "The minimum allowed value of gamma_b^2.",& units="nondim", default=0.0001) call get_param(param_file, mdl, "MEKE_CT", CS%MEKE_Ct, & - "A coefficient in the expression for the ratio of barotropic\n"//& + "A coefficient in the expression for the ratio of barotropic "//& "eddy energy and mean column energy (see Jansen et al. 2015).",& units="nondim", default=50.) call get_param(param_file, mdl, "MEKE_GMCOEFF", CS%MEKE_GMcoeff, & - "The efficiency of the conversion of potential energy \n"//& - "into MEKE by the thickness mixing parameterization. \n"//& - "If MEKE_GMCOEFF is negative, this conversion is not \n"//& + "The efficiency of the conversion of potential energy "//& + "into MEKE by the thickness mixing parameterization. "//& + "If MEKE_GMCOEFF is negative, this conversion is not "//& "used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_FRCOEFF", CS%MEKE_FrCoeff, & - "The efficiency of the conversion of mean energy into \n"//& - "MEKE. If MEKE_FRCOEFF is negative, this conversion \n"//& + "The efficiency of the conversion of mean energy into "//& + "MEKE. If MEKE_FRCOEFF is negative, this conversion "//& "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & "A background energy source for MEKE.", units="W kg-1", & default=0.0) call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & - "A background lateral diffusivity of MEKE.\n"//& + "A background lateral diffusivity of MEKE. "//& "Use a negative value to not apply lateral diffusion to MEKE.", & units="m2 s-1", default=-1.0) call get_param(param_file, mdl, "MEKE_K4", CS%MEKE_K4, & - "A lateral bi-harmonic diffusivity of MEKE.\n"//& + "A lateral bi-harmonic diffusivity of MEKE. "//& "Use a negative value to not apply bi-harmonic diffusion to MEKE.", & units="m4 s-1", default=-1.0) call get_param(param_file, mdl, "MEKE_DTSCALE", CS%MEKE_dtScale, & "A scaling factor to accelerate the time evolution of MEKE.", & units="nondim", default=1.0) call get_param(param_file, mdl, "MEKE_KHCOEFF", CS%MEKE_KhCoeff, & - "A scaling factor in the expression for eddy diffusivity\n"//& - "which is otherwise proportional to the MEKE velocity-\n"//& - "scale times an eddy mixing-length. This factor\n"//& - "must be >0 for MEKE to contribute to the thickness/\n"//& + "A scaling factor in the expression for eddy diffusivity "//& + "which is otherwise proportional to the MEKE velocity- "//& + "scale times an eddy mixing-length. This factor "//& + "must be >0 for MEKE to contribute to the thickness/ "//& "and tracer diffusivity in the rest of the model.", & units="nondim", default=1.0) call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, & - "The background velocity that is combined with MEKE to \n"//& + "The background velocity that is combined with MEKE to "//& "calculate the bottom drag.", units="m s-1", default=0.0) call get_param(param_file, mdl, "MEKE_VISC_DRAG", CS%visc_drag, & - "If true, use the vertvisc_type to calculate the bottom \n"//& + "If true, use the vertvisc_type to calculate the bottom "//& "drag acting on MEKE.", default=.true.) call get_param(param_file, mdl, "MEKE_KHTH_FAC", MEKE%KhTh_fac, & "A factor that maps MEKE%Kh to KhTh.", units="nondim", & @@ -959,71 +959,71 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "A factor that maps MEKE%Kh to Kh for MEKE itself.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_OLD_LSCALE", CS%use_old_lscale, & - "If true, use the old formula for length scale which is\n"//& + "If true, use the old formula for length scale which is "//& "a function of grid spacing and deformation radius.", & default=.false.) call get_param(param_file, mdl, "MEKE_MIN_LSCALE", CS%use_min_lscale, & - "If true, use a strict minimum of provided length scales\n"//& + "If true, use a strict minimum of provided length scales "//& "rather than harmonic mean.", & default=.false.) call get_param(param_file, mdl, "MEKE_RD_MAX_SCALE", CS%Rd_as_max_scale, & - "If true, the length scale used by MEKE is the minimum of\n"//& - "the deformation radius or grid-spacing. Only used if\n"//& + "If true, the length scale used by MEKE is the minimum of "//& + "the deformation radius or grid-spacing. Only used if "//& "MEKE_OLD_LSCALE=True", units="nondim", default=.false.) call get_param(param_file, mdl, "MEKE_VISCOSITY_COEFF", CS%viscosity_coeff, & - "If non-zero, is the scaling coefficient in the expression for\n"//& - "viscosity used to parameterize lateral momentum mixing by\n"//& - "unresolved eddies represented by MEKE. Can be negative to\n"//& + "If non-zero, is the scaling coefficient in the expression for "//& + "viscosity used to parameterize lateral momentum mixing by "//& + "unresolved eddies represented by MEKE. Can be negative to "//& "represent backscatter from the unresolved eddies.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & - "If positive, is a fixed length contribution to the expression\n"//& + "If positive, is a fixed length contribution to the expression "//& "for mixing length used in MEKE-derived diffusivity.", & units="m", default=0.0) call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, & - "If positive, is a coefficient weighting the deformation scale\n"//& + "If positive, is a coefficient weighting the deformation scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_ALPHA_RHINES", CS%aRhines, & - "If positive, is a coefficient weighting the Rhines scale\n"//& + "If positive, is a coefficient weighting the Rhines scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.05) call get_param(param_file, mdl, "MEKE_ALPHA_EADY", CS%aEady, & - "If positive, is a coefficient weighting the Eady length scale\n"//& + "If positive, is a coefficient weighting the Eady length scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.05) call get_param(param_file, mdl, "MEKE_ALPHA_FRICT", CS%aFrict, & - "If positive, is a coefficient weighting the frictional arrest scale\n"//& + "If positive, is a coefficient weighting the frictional arrest scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_ALPHA_GRID", CS%aGrid, & - "If positive, is a coefficient weighting the grid-spacing as a scale\n"//& + "If positive, is a coefficient weighting the grid-spacing as a scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_COLD_START", coldStart, & - "If true, initialize EKE to zero. Otherwise a local equilibrium solution\n"//& + "If true, initialize EKE to zero. Otherwise a local equilibrium solution "//& "is used as an initial condition for EKE.", default=.false.) call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_C", MEKE%backscatter_Ro_c, & - "The coefficient in the Rossby number function for scaling the biharmonic\n"//& + "The coefficient in the Rossby number function for scaling the biharmonic "//& "frictional energy source. Setting to non-zero enables the Rossby number function.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_POW", MEKE%backscatter_Ro_pow, & - "The power in the Rossby number function for scaling the biharmonic\n"//& + "The power in the Rossby number function for scaling the biharmonic "//& "frictional energy source.", units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_ADVECTION_FACTOR", CS%MEKE_advection_factor, & - "A scale factor in front of advection of eddy energy. Zero turns advection off.\n"//& - "Using unity would be normal but other values could accommodate a mismatch\n"//& + "A scale factor in front of advection of eddy energy. Zero turns advection off. "//& + "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_TOPOGRAPHIC_BETA", CS%MEKE_topographic_beta, & - "A scale factor to determine how much topographic beta is weighed in\n" //& - "computing beta in the expression of Rhines scale. Use 1 if full\n"//& + "A scale factor to determine how much topographic beta is weighed in " //& + "computing beta in the expression of Rhines scale. Use 1 if full "//& "topographic beta effect is considered; use 0 if it's completely ignored.", & units="nondim", default=0.0) ! Nonlocal module parameters call get_param(param_file, mdl, "CDRAG", CS%cdrag, & - "CDRAG is the drag coefficient relating the magnitude of \n"//& + "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the bottom stress.", units="nondim", & default=0.003) call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 594e4d9e9c..c43f6744d0 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1069,18 +1069,18 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "The minimum value allowed for Laplacian horizontal viscosity, KH.", & units = "m2 s-1", default=0.0) call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & - "The velocity scale which is multiplied by the grid \n"//& - "spacing to calculate the Laplacian viscosity. \n"//& - "The final viscosity is the largest of this scaled \n"//& + "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) call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & - "The amplitude of a latitudinally-dependent background\n"//& + "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) if (Kh_sin_lat>0. .or. get_all) & 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-\n"//& + "The power used to raise SIN(LAT) when using a latitudinally "//& "dependent background viscosity.", & units = "nondim", default=4.0) @@ -1089,7 +1089,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) default=.false.) if (CS%Smagorinsky_Kh .or. get_all) & call get_param(param_file, mdl, "SMAG_LAP_CONST", Smag_Lap_const, & - "The nondimensional Laplacian Smagorinsky constant, \n"//& + "The nondimensional Laplacian Smagorinsky constant, "//& "often 0.15.", units="nondim", default=0.0, & fail_if_missing = CS%Smagorinsky_Kh) @@ -1098,7 +1098,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) default=.false.) 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.) call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & @@ -1107,19 +1107,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Leith_Kh .or. get_all) & call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & - "The nondimensional Laplacian Leith constant, \n"//& + "The nondimensional Laplacian Leith constant, "//& "often ??", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Kh) call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & - "If true, the Laplacian coefficient is locally limited \n"//& + "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, & - "If true, the Laplacian coefficient is locally limited \n"//& + "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, & - "If true, allow anistropic viscosity in the Laplacian\n"//& + "If true, allow anistropic viscosity in the Laplacian "//& "horizontal viscosity.", default=.false.) endif if (CS%anisotropic .or. get_all) then @@ -1135,19 +1135,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) 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\n"//& - "horizont viscosity. n1,n2 are the i,j components relative\n"//& + "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\n"//& - "horizont viscosity. n1,n2 are the i,j components relative\n"//& + "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 endif call get_param(param_file, mdl, "BIHARMONIC", CS%biharmonic, & - "If true, use a biharmonic horizontal viscosity. \n"//& + "If true, use a biharmonic horizontal viscosity. "//& "BIHARMONIC may be used with LAPLACIAN.", & default=.true.) if (CS%biharmonic .or. get_all) then @@ -1155,52 +1155,52 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "The background biharmonic horizontal viscosity.", & units = "m4 s-1", default=0.0) call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & - "The velocity scale which is multiplied by the cube of \n"//& - "the grid spacing to calculate the biharmonic viscosity. \n"//& - "The final viscosity is the largest of this scaled \n"//& + "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) call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & - "A time scale whose inverse is multiplied by the fourth \n"//& - "power of the grid spacing to calculate biharmonic viscosity. \n"//& - "The final viscosity is the largest of all viscosity \n"//& + "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) call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & - "If true, use a biharmonic Smagorinsky nonlinear eddy \n"//& + "If true, use a biharmonic Smagorinsky nonlinear eddy "//& "viscosity.", default=.false.) call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & - "If true, use a biharmonic Leith nonlinear eddy \n"//& + "If true, use a biharmonic Leith nonlinear eddy "//& "viscosity.", default=.false.) call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & - "If true, the biharmonic coefficient is locally limited \n"//& + "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, & - "If true, the biharmonic coefficient is locally limited \n"//& + "If true, the biharmonic coefficient is locally limited "//& "to be stable with a better bounding than just BOUND_AH.", & default=CS%bound_Ah) if (CS%Smagorinsky_Ah .or. get_all) then call get_param(param_file, mdl, "SMAG_BI_CONST",Smag_bi_const, & - "The nondimensional biharmonic Smagorinsky constant, \n"//& + "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, & - "If true use a viscosity that increases with the square \n"//& - "of the velocity shears, so that the resulting viscous \n"//& - "drag is of comparable magnitude to the Coriolis terms \n"//& - "when the velocity differences between adjacent grid \n"//& - "points is 0.5*BOUND_CORIOLIS_VEL. The default is the \n"//& + "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, & - "The velocity scale at which BOUND_CORIOLIS_BIHARM causes \n"//& - "the biharmonic drag to have comparable magnitude to the \n"//& + "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) endif @@ -1208,7 +1208,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Leith_Ah .or. get_all) then call get_param(param_file, mdl, "LEITH_BI_CONST",Leith_bi_const, & - "The nondimensional biharmonic Leith constant, \n"//& + "The nondimensional biharmonic Leith constant, "//& "typical values are thus far undetermined", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Ah) endif @@ -1216,30 +1216,30 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) endif 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 \n"//& - "at velocity locations. This eliminates the dependence on arbitrary \n"//& - "values over land or outside of the domain. Default is False in order to \n"//& - "maintain answers with legacy experiments but should be changed to True \n"//& + "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 is False in order to "//& + "maintain answers with legacy experiments but should be changed to True "//& "for new experiments.", default=.false.) 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, & - "The nondimensional coefficient of the ratio of the \n"//& - "viscosity bounds to the theoretical maximum for \n"//& + "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) call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & - "If true, no slip boundary conditions are used; otherwise \n"//& - "free slip boundary conditions are assumed. The \n"//& - "implementation of the free slip BCs on a C-grid is much \n"//& - "cleaner than the no slip BCs. The use of free slip BCs \n"//& - "is strongly encouraged, and no slip BCs are not used with \n"//& + "If true, no slip boundary conditions are used; otherwise "//& + "free slip boundary conditions are assumed. The "//& + "implementation of the free slip BCs on a C-grid is much "//& + "cleaner than the no slip BCs. The use of free slip BCs "//& + "is strongly encouraged, and no slip BCs are not used with "//& "the biharmonic viscosity.", default=.false.) 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 \n"//& - "viscosities. The final viscosity is the maximum of the other \n"//& + "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.) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 2f7e85701b..fb35d5b45c 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -2191,13 +2191,13 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "INTERNAL_TIDE_FREQS", num_freq, & - "The number of distinct internal tide frequency bands \n"//& + "The number of distinct internal tide frequency bands "//& "that will be calculated.", default=1) call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", num_mode, & - "The number of distinct internal tide modes \n"//& + "The number of distinct internal tide modes "//& "that will be calculated.", default=1) call get_param(param_file, mdl, "INTERNAL_TIDE_ANGLES", num_angle, & - "The number of angular resolution bands for the internal \n"//& + "The number of angular resolution bands for the internal "//& "tide calculations.", default=24) if (use_int_tides) then @@ -2227,34 +2227,34 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag call get_param(param_file, mdl, "INTERNAL_TIDE_DECAY_RATE", CS%decay_rate, & - "The rate at which internal tide energy is lost to the \n"//& + "The rate at which internal tide energy is lost to the "//& "interior ocean internal wave field.", units="s-1", default=0.0) call get_param(param_file, mdl, "INTERNAL_TIDE_VOLUME_BASED_CFL", CS%vol_CFL, & - "If true, use the ratio of the open face lengths to the \n"//& - "tracer cell areas when estimating CFL numbers in the \n"//& + "If true, use the ratio of the open face lengths to the "//& + "tracer cell areas when estimating CFL numbers in the "//& "internal tide code.", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_CORNER_ADVECT", CS%corner_adv, & - "If true, internal tide ray-tracing advection uses a \n"//& - " corner-advection scheme rather than PPM.\n", default=.false.) + "If true, internal tide ray-tracing advection uses a "//& + "corner-advection scheme rather than PPM.", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_SIMPLE_2ND_PPM", CS%simple_2nd, & - "If true, CONTINUITY_PPM uses a simple 2nd order \n"//& - "(arithmetic mean) interpolation of the edge values. \n"//& - "This may give better PV conservation properties. While \n"//& - "it formally reduces the accuracy of the continuity \n"//& - "solver itself in the strongly advective limit, it does \n"//& - "not reduce the overall order of accuracy of the dynamic \n"//& + "If true, CONTINUITY_PPM uses a simple 2nd order "//& + "(arithmetic mean) interpolation of the edge values. "//& + "This may give better PV conservation properties. While "//& + "it formally reduces the accuracy of the continuity "//& + "solver itself in the strongly advective limit, it does "//& + "not reduce the overall order of accuracy of the dynamic "//& "core.", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_UPWIND_1ST", CS%upwind_1st, & - "If true, the internal tide ray-tracing advection uses \n"//& - "1st-order upwind advection. This scheme is highly \n"//& - "continuity solver. This scheme is highly \n"//& + "If true, the internal tide ray-tracing advection uses "//& + "1st-order upwind advection. This scheme is highly "//& + "continuity solver. This scheme is highly "//& "diffusive but may be useful for debugging.", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_BACKGROUND_DRAG", & - CS%apply_background_drag, "If true, the internal tide \n"//& + CS%apply_background_drag, "If true, the internal tide "//& "ray-tracing advection uses a background drag term as a sink.",& default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_QUAD_DRAG", CS%apply_bottom_drag, & - "If true, the internal tide ray-tracing advection uses \n"//& + "If true, the internal tide ray-tracing advection uses "//& "a quadratic bottom drag term as a sink.", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_WAVE_DRAG", CS%apply_wave_drag, & "If true, apply scattering due to small-scale roughness as a sink.", & @@ -2263,22 +2263,22 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "If true, apply wave breaking as a sink.", & default=.false.) call get_param(param_file, mdl, "CDRAG", CS%cdrag, & - "CDRAG is the drag coefficient relating the magnitude of \n"//& + "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the bottom stress.", units="nondim", & default=0.003) call get_param(param_file, mdl, "INTERNAL_TIDE_ENERGIZED_ANGLE", CS%energized_angle, & - "If positive, only one angular band of the internal tides \n"//& + "If positive, only one angular band of the internal tides "//& "gets all of the energy. (This is for debugging.)", default=-1) call get_param(param_file, mdl, "USE_PPM_ANGULAR", CS%use_PPMang, & - "If true, use PPM for advection of energy in angular \n"//& - "space.", default=.false.) + "If true, use PPM for advection of energy in angular space.", & + default=.false.) call get_param(param_file, mdl, "GAMMA_ITIDES", CS%q_itides, & - "The fraction of the internal tidal energy that is \n"//& - "dissipated locally with INT_TIDE_DISSIPATION. \n"//& + "The fraction of the internal tidal energy that is "//& + "dissipated locally with INT_TIDE_DISSIPATION. "//& "THIS NAME COULD BE BETTER.", & units="nondim", default=0.3333) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & - "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& + "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & units="m-1", default=8.e-4*atan(1.0)) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & @@ -2304,7 +2304,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Compute the fixed part of the bottom drag loss from baroclinic modes call get_param(param_file, mdl, "H2_FILE", h2_file, & - "The path to the file containing the sub-grid-scale \n"//& + "The path to the file containing the sub-grid-scale "//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) @@ -2323,7 +2323,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Read in prescribed coast/ridge/shelf angles from file call get_param(param_file, mdl, "REFL_ANGLE_FILE", refl_angle_file, & - "The path to the file containing the local angle of \n"//& + "The path to the file containing the local angle of "//& "the coastline/ridge/shelf with respect to the equator.", & fail_if_missing=.false.) filename = trim(CS%inputdir) // trim(refl_angle_file) @@ -2437,7 +2437,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) Time, 'Interior and bottom drag internal tide decay timescale', 's-1') !Register 2-D energy input into internal tides CS%id_TKE_itidal_input = register_diag_field('ocean_model', 'TKE_itidal_input', diag%axesT1, & - Time, 'Conversion from barotropic to baroclinic tide, \n'//& + Time, 'Conversion from barotropic to baroclinic tide, '//& 'a fraction of which goes into rays', 'W m-2') ! Register 2-D energy losses (summed over angles, freq, modes) CS%id_tot_leak_loss = register_diag_field('ocean_model', 'ITide_tot_leak_loss', diag%axesT1, & diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 24b44fab9f..2a855f4416 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -752,42 +752,42 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "USE_VARIABLE_MIXING", CS%use_variable_mixing,& - "If true, the variable mixing code will be called. This \n"//& - "allows diagnostics to be created even if the scheme is \n"//& - "not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, \n"//& - "this is set to true regardless of what is in the \n"//& + "If true, the variable mixing code will be called. This "//& + "allows diagnostics to be created even if the scheme is "//& + "not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, "//& + "this is set to true regardless of what is in the "//& "parameter file.", default=.false.) call get_param(param_file, mdl, "RESOLN_SCALED_KH", CS%Resoln_scaled_Kh, & - "If true, the Laplacian lateral viscosity is scaled away \n"//& - "when the first baroclinic deformation radius is well \n"//& + "If true, the Laplacian lateral viscosity is scaled away "//& + "when the first baroclinic deformation radius is well "//& "resolved.", default=.false.) call get_param(param_file, mdl, "RESOLN_SCALED_KHTH", CS%Resoln_scaled_KhTh, & - "If true, the interface depth diffusivity is scaled away \n"//& - "when the first baroclinic deformation radius is well \n"//& + "If true, the interface depth diffusivity is scaled away "//& + "when the first baroclinic deformation radius is well "//& "resolved.", default=.false.) call get_param(param_file, mdl, "RESOLN_SCALED_KHTR", CS%Resoln_scaled_KhTr, & - "If true, the epipycnal tracer diffusivity is scaled \n"//& - "away when the first baroclinic deformation radius is \n"//& + "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, "RESOLN_USE_EBT", CS%Resoln_use_ebt, & - "If true, uses the equivalent barotropic wave speed instead\n"//& + "If true, uses the equivalent barotropic wave speed instead "//& "of first baroclinic wave for calculating the resolution fn.",& default=.false.) call get_param(param_file, mdl, "KHTH_USE_EBT_STRUCT", CS%khth_use_ebt_struct, & - "If true, uses the equivalent barotropic structure\n"//& + "If true, uses the equivalent barotropic structure "//& "as the vertical structure of thickness diffusivity.",& default=.false.) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", KhTh_Slope_Cff, & - "The nondimensional coefficient in the Visbeck formula \n"//& + "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & default=0.0) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", KhTr_Slope_Cff, & - "The nondimensional coefficient in the Visbeck formula \n"//& + "The nondimensional coefficient in the Visbeck formula "//& "for the epipycnal tracer diffusivity", units="nondim", & default=0.0) call get_param(param_file, mdl, "USE_STORED_SLOPES", CS%use_stored_slopes,& - "If true, the isopycnal slopes are calculated once and\n"//& - "stored for re-use. This uses more memory but avoids calling\n"//& + "If true, the isopycnal slopes are calculated once and "//& + "stored for re-use. This uses more memory but avoids calling "//& "the equation of state more times than should be necessary.", & default=.false.) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & @@ -809,7 +809,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then in_use = .true. call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & - "The depth below which N2 is monotonized to avoid stratification\n"//& + "The depth below which N2 is monotonized to avoid stratification "//& "artifacts from altering the equivalent barotropic mode structure.",& units='m', default=2000.) allocate(CS%ebt_struct(isd:ied,jsd:jed,G%ke)) ; CS%ebt_struct(:,:,:) = 0.0 @@ -818,8 +818,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (KhTr_Slope_Cff>0. .or. KhTh_Slope_Cff>0.) then CS%calculate_Eady_growth_rate = .true. call get_param(param_file, mdl, "VISBECK_MAX_SLOPE", CS%Visbeck_S_max, & - "If non-zero, is an upper bound on slopes used in the\n"// & - "Visbeck formula for diffusivity. This does not affect the\n"// & + "If non-zero, is an upper bound on slopes used in the "//& + "Visbeck formula for diffusivity. This does not affect the "//& "isopycnal slope calculation used within thickness diffusion.", & units="nondim", default=0.0) endif @@ -829,7 +829,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%slope_x(IsdB:IedB,jsd:jed,G%ke+1)) ; CS%slope_x(:,:,:) = 0.0 allocate(CS%slope_y(isd:ied,JsdB:JedB,G%ke+1)) ; CS%slope_y(:,:,:) = 0.0 call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & - "A diapycnal diffusivity that is used to interpolate \n"//& + "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & default=1.0e-6, scale=US%m_to_Z**2) !### Add units argument. endif @@ -843,7 +843,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & 'Inverse eddy time-scale, S*N, at v-points', 's-1') call get_param(param_file, mdl, "VARMIX_KTOP", CS%VarMix_Ktop, & - "The layer number at which to start vertical integration \n"//& + "The layer number at which to start vertical integration "//& "of S*N for purposes of finding the Eady growth rate.", & units="nondim", default=2) endif @@ -902,39 +902,39 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) 'Resolution function for scaling diffusivities', 'nondim') call get_param(param_file, mdl, "KH_RES_SCALE_COEF", CS%Res_coef_khth, & - "A coefficient that determines how KhTh is scaled away if \n"//& - "RESOLN_SCALED_... is true, as \n"//& + "A coefficient that determines how KhTh is scaled away if "//& + "RESOLN_SCALED_... is true, as "//& "F = 1 / (1 + (KH_RES_SCALE_COEF*Rd/dx)^KH_RES_FN_POWER).", & units="nondim", default=1.0) call get_param(param_file, mdl, "KH_RES_FN_POWER", CS%Res_fn_power_khth, & - "The power of dx/Ld in the Kh resolution function. Any \n"//& - "positive integer may be used, although even integers \n"//& - "are more efficient to calculate. Setting this greater \n"//& + "The power of dx/Ld in the Kh resolution function. Any "//& + "positive integer may be used, although even integers "//& + "are more efficient to calculate. Setting this greater "//& "than 100 results in a step-function being used.", & units="nondim", default=2) call get_param(param_file, mdl, "VISC_RES_SCALE_COEF", CS%Res_coef_visc, & - "A coefficient that determines how Kh is scaled away if \n"//& - "RESOLN_SCALED_... is true, as \n"//& - "F = 1 / (1 + (KH_RES_SCALE_COEF*Rd/dx)^KH_RES_FN_POWER).\n"//& + "A coefficient that determines how Kh is scaled away if "//& + "RESOLN_SCALED_... is true, as "//& + "F = 1 / (1 + (KH_RES_SCALE_COEF*Rd/dx)^KH_RES_FN_POWER). "//& "This function affects lateral viscosity, Kh, and not KhTh.", & units="nondim", default=CS%Res_coef_khth) call get_param(param_file, mdl, "VISC_RES_FN_POWER", CS%Res_fn_power_visc, & - "The power of dx/Ld in the Kh resolution function. Any \n"//& - "positive integer may be used, although even integers \n"//& - "are more efficient to calculate. Setting this greater \n"//& - "than 100 results in a step-function being used.\n"//& + "The power of dx/Ld in the Kh resolution function. Any "//& + "positive integer may be used, although even integers "//& + "are more efficient to calculate. Setting this greater "//& + "than 100 results in a step-function being used. "//& "This function affects lateral viscosity, Kh, and not KhTh.", & units="nondim", default=CS%Res_fn_power_khth) call get_param(param_file, mdl, "INTERPOLATE_RES_FN", CS%interpolate_Res_fn, & - "If true, interpolate the resolution function to the \n"//& - "velocity points from the thickness points; otherwise \n"//& - "interpolate the wave speed and calculate the resolution \n"//& + "If true, interpolate the resolution function to the "//& + "velocity points from the thickness points; otherwise "//& + "interpolate the wave speed and calculate the resolution "//& "function independently at each point.", default=.true.) call get_param(param_file, mdl, "USE_VISBECK_SLOPE_BUG", CS%use_Visbeck_slope_bug, & - "If true, then retain a legacy bug in the calculation of weights \n"//& - "applied to isoneutral slopes. There was an erroneous k-indexing \n"//& - "for layer thicknesses. In addition, masking at coastlines was not \n"//& - "used which introduced potential restart issues. This flag will be \n"//& + "If true, then retain a legacy bug in the calculation of weights "//& + "applied to isoneutral slopes. There was an erroneous k-indexing "//& + "for layer thicknesses. In addition, masking at coastlines was not "//& + "used which introduced potential restart issues. This flag will be "//& "deprecated in a future release.", default=.false.) if (CS%interpolate_Res_fn) then if (CS%Res_coef_visc /= CS%Res_coef_khth) call MOM_error(FATAL, & @@ -946,11 +946,11 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif !### Change the default of GILL_EQUATORIAL_LD to True. call get_param(param_file, mdl, "GILL_EQUATORIAL_LD", Gill_equatorial_Ld, & - "If true, uses Gill's definition of the baroclinic\n"//& - "equatorial deformation radius, otherwise, if false, use\n"//& - "Pedlosky's definition. These definitions differ by a factor \n"//& - "of 2 in front of the beta term in the denominator. Gill's \n"//& - "is the more appropriate definition.\n", default=.false.) + "If true, uses Gill's definition of the baroclinic "//& + "equatorial deformation radius, otherwise, if false, use "//& + "Pedlosky's definition. These definitions differ by a factor "//& + "of 2 in front of the beta term in the denominator. Gill's "//& + "is the more appropriate definition.", default=.false.) if (Gill_equatorial_Ld) then oneOrTwo = 2.0 else diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 9077dd0f18..5507ebea16 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -797,9 +797,9 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, 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, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & - "If true, a density-gradient dependent re-stratifying \n"//& - "flow is imposed in the mixed layer. Can be used in ALE mode\n"//& - "without restriction but in layer mode can only be used if\n"//& + "If true, a density-gradient dependent re-stratifying "//& + "flow is imposed in the mixed layer. Can be used in ALE mode "//& + "without restriction but in layer mode can only be used if "//& "BULKMIXEDLAYER is true.", default=.false.) if (.not. mixedlayer_restrat_init) return @@ -817,53 +817,53 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF", CS%ml_restrat_coef, & - "A nondimensional coefficient that is proportional to \n"//& - "the ratio of the deformation radius to the dominant \n"//& - "lengthscale of the submesoscale mixed layer \n"//& - "instabilities, times the minimum of the ratio of the \n"//& - "mesoscale eddy kinetic energy to the large-scale \n"//& - "geostrophic kinetic energy or 1 plus the square of the \n"//& - "grid spacing over the deformation radius, as detailed \n"//& + "A nondimensional coefficient that is proportional to "//& + "the ratio of the deformation radius to the dominant "//& + "lengthscale of the submesoscale mixed layer "//& + "instabilities, times the minimum of the ratio of the "//& + "mesoscale eddy kinetic energy to the large-scale "//& + "geostrophic kinetic energy or 1 plus the square of the "//& + "grid spacing over the deformation radius, as detailed "//& "by Fox-Kemper et al. (2010)", units="nondim", default=0.0) ! We use GV%nkml to distinguish between the old and new implementation of MLE. ! The old implementation only works for the layer model with nkml>0. if (GV%nkml==0) then call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF2", CS%ml_restrat_coef2, & - "As for FOX_KEMPER_ML_RESTRAT_COEF but used in a second application\n"//& + "As for FOX_KEMPER_ML_RESTRAT_COEF but used in a second application "//& "of the MLE restratification parameterization.", units="nondim", default=0.0) call get_param(param_file, mdl, "MLE_FRONT_LENGTH", CS%front_length, & - "If non-zero, is the frontal-length scale used to calculate the\n"//& - "upscaling of buoyancy gradients that is otherwise represented\n"//& - "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is\n"//& + "If non-zero, is the frontal-length scale used to calculate the "//& + "upscaling of buoyancy gradients that is otherwise represented "//& + "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is "//& "non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0.",& units="m", default=0.0) call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & - "If true, the MLE parameterization will use the mixed-layer\n"//& - "depth provided by the active PBL parameterization. If false,\n"//& - "MLE will estimate a MLD based on a density difference with the\n"//& + "If true, the MLE parameterization will use the mixed-layer "//& + "depth provided by the active PBL parameterization. If false, "//& + "MLE will estimate a MLD based on a density difference with the "//& "surface using the parameter MLE_DENSITY_DIFF.", default=.false.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & - "The time-scale for a running-mean filter applied to the mixed-layer\n"//& - "depth used in the MLE restratification parameterization. When\n"//& - "the MLD deepens below the current running-mean the running-mean\n"//& + "The time-scale for a running-mean filter applied to the mixed-layer "//& + "depth used in the MLE restratification parameterization. When "//& + "the MLD deepens below the current running-mean the running-mean "//& "is instantaneously set to the current MLD.", units="s", default=0.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & - "The time-scale for a running-mean filter applied to the filtered\n"//& - "mixed-layer depth used in a second MLE restratification parameterization.\n"//& - "When the MLD deepens below the current running-mean the running-mean\n"//& + "The time-scale for a running-mean filter applied to the filtered "//& + "mixed-layer depth used in a second MLE restratification parameterization. "//& + "When the MLD deepens below the current running-mean the running-mean "//& "is instantaneously set to the current MLD.", units="s", default=0.) if (.not. CS%MLE_use_PBL_MLD) then call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & - "Density difference used to detect the mixed-layer\n"//& - "depth used for the mixed-layer eddy parameterization\n"//& + "Density difference used to detect the mixed-layer "//& + "depth used for the mixed-layer eddy parameterization "//& "by Fox-Kemper et al. (2010)", units="kg/m3", default=0.03) endif call get_param(param_file, mdl, "MLE_TAIL_DH", CS%MLE_tail_dh, & - "Fraction by which to extend the mixed-layer restratification\n"//& - "depth used for a smoother stream function at the base of\n"//& + "Fraction by which to extend the mixed-layer restratification "//& + "depth used for a smoother stream function at the base of "//& "the mixed-layer.", units="nondim", default=0.0) call get_param(param_file, mdl, "MLE_MLD_STRETCH", CS%MLE_MLD_stretch, & - "A scaling coefficient for stretching/shrinking the MLD\n"//& + "A scaling coefficient for stretching/shrinking the MLD "//& "used in the MLE scheme. This simply multiplies MLD wherever used.",& units="nondim", default=1.0) call get_param(param_file, mdl, "MLE_USE_MLD_AVE_BUG", CS%MLE_use_MLD_ave_bug, & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index e13e639ae5..4d75494b72 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1718,13 +1718,13 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, 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, "THICKNESSDIFFUSE", CS%thickness_diffuse, & - "If true, interface heights are diffused with a \n"//& + "If true, interface heights are diffused with a "//& "coefficient of KHTH.", default=.false.) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & units = "m2 s-1", default=0.0) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & - "The nondimensional coefficient in the Visbeck formula \n"//& + "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & default=0.0) call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & @@ -1734,45 +1734,45 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "The maximum horizontal thickness diffusivity.", & units = "m2 s-1", default=0.0) call get_param(param_file, mdl, "KHTH_MAX_CFL", CS%max_Khth_CFL, & - "The maximum value of the local diffusive CFL ratio that \n"//& - "is permitted for the thickness diffusivity. 1.0 is the \n"//& - "marginally unstable value in a pure layered model, but \n"//& - "much smaller numbers (e.g. 0.1) seem to work better for \n"//& + "The maximum value of the local diffusive CFL ratio that "//& + "is permitted for the thickness diffusivity. 1.0 is the "//& + "marginally unstable value in a pure layered model, but "//& + "much smaller numbers (e.g. 0.1) seem to work better for "//& "ALE-based models.", units = "nondimensional", default=0.8) if (CS%max_Khth_CFL < 0.0) CS%max_Khth_CFL = 0.0 call get_param(param_file, mdl, "DETANGLE_INTERFACES", CS%detangle_interfaces, & - "If defined add 3-d structured enhanced interface height \n"//& + "If defined add 3-d structured enhanced interface height "//& "diffusivities to horizontally smooth jagged layers.", & default=.false.) CS%detangle_time = 0.0 if (CS%detangle_interfaces) & call get_param(param_file, mdl, "DETANGLE_TIMESCALE", CS%detangle_time, & - "A timescale over which maximally jagged grid-scale \n"//& - "thickness variations are suppressed. This must be \n"//& + "A timescale over which maximally jagged grid-scale "//& + "thickness variations are suppressed. This must be "//& "longer than DT, or 0 to use DT.", units = "s", default=0.0) call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & - "A slope beyond which the calculated isopycnal slope is \n"//& + "A slope beyond which the calculated isopycnal slope is "//& "not reliable and is scaled away.", units="nondim", default=0.01) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & - "A diapycnal diffusivity that is used to interpolate \n"//& + "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & default=1.0e-6, scale=US%m_to_Z**2) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & - "If true, use the streamfunction formulation of\n"// & - "Ferrari et al., 2010, which effectively emphasizes\n"//& + "If true, use the streamfunction formulation of "//& + "Ferrari et al., 2010, which effectively emphasizes "//& "graver vertical modes by smoothing in the vertical.", & default=.false.) call get_param(param_file, mdl, "FGNV_FILTER_SCALE", CS%FGNV_scale, & - "A coefficient scaling the vertical smoothing term in the\n"//& + "A coefficient scaling the vertical smoothing term in the "//& "Ferrari et al., 2010, streamfunction formulation.", & default=1., do_not_log=.not.CS%use_FGNV_streamfn) call get_param(param_file, mdl, "FGNV_C_MIN", CS%FGNV_c_min, & - "A minium wave speed used in the Ferrari et al., 2010,\n"//& + "A minium wave speed used in the Ferrari et al., 2010, "//& "streamfunction formulation.", & default=0., units="m s-1", do_not_log=.not.CS%use_FGNV_streamfn) call get_param(param_file, mdl, "FGNV_STRAT_FLOOR", strat_floor, & - "A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010,\n"//& - "streamfunction formulation, expressed as a fraction of planetary\n"//& + "A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, "//& + "streamfunction formulation, expressed as a fraction of planetary "//& "rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", & default=1.e-15, units="nondim", do_not_log=.not.CS%use_FGNV_streamfn) call get_param(param_file, mdl, "OMEGA",omega, & diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 156cd0ff54..57a1d78c03 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -123,43 +123,43 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) enddo ; enddo call get_param(param_file, mdl, "TIDE_M2", use_M2, & - "If true, apply tidal momentum forcing at the M2 \n"//& + "If true, apply tidal momentum forcing at the M2 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_S2", use_S2, & - "If true, apply tidal momentum forcing at the S2 \n"//& + "If true, apply tidal momentum forcing at the S2 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_N2", use_N2, & - "If true, apply tidal momentum forcing at the N2 \n"//& + "If true, apply tidal momentum forcing at the N2 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_K2", use_K2, & - "If true, apply tidal momentum forcing at the K2 \n"//& + "If true, apply tidal momentum forcing at the K2 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_K1", use_K1, & - "If true, apply tidal momentum forcing at the K1 \n"//& + "If true, apply tidal momentum forcing at the K1 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_O1", use_O1, & - "If true, apply tidal momentum forcing at the O1 \n"//& + "If true, apply tidal momentum forcing at the O1 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_P1", use_P1, & - "If true, apply tidal momentum forcing at the P1 \n"//& + "If true, apply tidal momentum forcing at the P1 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_Q1", use_Q1, & - "If true, apply tidal momentum forcing at the Q1 \n"//& + "If true, apply tidal momentum forcing at the Q1 "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_MF", use_MF, & - "If true, apply tidal momentum forcing at the MF \n"//& + "If true, apply tidal momentum forcing at the MF "//& "frequency. This is only used if TIDES is true.", & default=.false.) call get_param(param_file, mdl, "TIDE_MM", use_MM, & - "If true, apply tidal momentum forcing at the MM \n"//& + "If true, apply tidal momentum forcing at the MM "//& "frequency. This is only used if TIDES is true.", & default=.false.) @@ -179,23 +179,23 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) endif call get_param(param_file, mdl, "TIDAL_SAL_FROM_FILE", CS%tidal_sal_from_file, & - "If true, read the tidal self-attraction and loading \n"//& - "from input files, specified by TIDAL_INPUT_FILE. \n"//& + "If true, read the tidal self-attraction and loading "//& + "from input files, specified by TIDAL_INPUT_FILE. "//& "This is only used if TIDES is true.", default=.false.) call get_param(param_file, mdl, "USE_PREVIOUS_TIDES", CS%use_prev_tides, & - "If true, use the SAL from the previous iteration of the \n"//& - "tides to facilitate convergent iteration. \n"//& + "If true, use the SAL from the previous iteration of the "//& + "tides to facilitate convergent iteration. "//& "This is only used if TIDES is true.", default=.false.) call get_param(param_file, mdl, "TIDE_USE_SAL_SCALAR", CS%use_sal_scalar, & - "If true and TIDES is true, use the scalar approximation \n"//& + "If true and TIDES is true, use the scalar approximation "//& "when calculating self-attraction and loading.", & default=.not.CS%tidal_sal_from_file) ! If it is being used, sal_scalar MUST be specified in param_file. if (CS%use_sal_scalar .or. CS%use_prev_tides) & call get_param(param_file, mdl, "TIDE_SAL_SCALAR_VALUE", CS%sal_scalar, & - "The constant of proportionality between sea surface \n"//& - "height (really it should be bottom pressure) anomalies \n"//& - "and bottom geopotential anomalies. This is only used if \n"//& + "The constant of proportionality between sea surface "//& + "height (really it should be bottom pressure) anomalies "//& + "and bottom geopotential anomalies. This is only used if "//& "TIDES and TIDE_USE_SAL_SCALAR are true.", units="m m-1", & fail_if_missing=.true.) @@ -290,15 +290,15 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) ! values that are actually used. do c=1,nc call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_FREQ", CS%freq(c), & - "Frequency of the "//trim(CS%const_name(c))//" tidal constituent. \n"//& + "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.", units="s-1", default=freq_def(c)) 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. \n"//& + "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)) 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. \n"//& + "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))// & " are true.", units="radians", default=phase0_def(c)) enddo diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 7678a4b799..0cc63a8fc0 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -170,8 +170,8 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ ! Set default, read and log parameters call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SPONGE", use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) if (.not.use_sponge) return @@ -183,14 +183,14 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ default=.false.) call get_param(param_file, mdl, "REMAPPING_SCHEME", remapScheme, & - "This sets the reconstruction scheme used \n"//& + "This sets the reconstruction scheme used "//& " for vertical remapping for all variables.", & default="PLM", do_not_log=.true.) call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", bndExtrapolation, & - "When defined, a proper high-order reconstruction \n"//& - "scheme is used within boundary cells rather \n"// & - "than PCM. E.g., if PPM is used for remapping, a \n" //& + "When defined, a proper high-order reconstruction "//& + "scheme is used within boundary cells rather "//& + "than PCM. E.g., if PPM is used for remapping, a "//& "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) @@ -401,8 +401,8 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SPONGE", use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) if (.not.use_sponge) return @@ -414,14 +414,14 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) default=.false.) call get_param(param_file, mdl, "REMAPPING_SCHEME", remapScheme, & - "This sets the reconstruction scheme used \n"//& + "This sets the reconstruction scheme used "//& " for vertical remapping for all variables.", & default="PLM", do_not_log=.true.) call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", bndExtrapolation, & - "When defined, a proper high-order reconstruction \n"//& - "scheme is used within boundary cells rather \n"// & - "than PCM. E.g., if PPM is used for remapping, a \n" //& + "When defined, a proper high-order reconstruction "//& + "scheme is used within boundary cells rather "//& + "than PCM. E.g., if PPM is used for remapping, a "//& "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 68d7085b30..0eeef2203b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -201,7 +201,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) call log_version(paramFile, mdl, version, 'This is the MOM wrapper to CVMix:KPP\n' // & 'See http://cvmix.github.io/') call get_param(paramFile, mdl, "USE_KPP", KPP_init, & - "If true, turns on the [CVMix] KPP scheme of Large et al., 1994,\n"// & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "// & "to calculate diffusivities and non-local transport in the OBL.", & default=.false.) ! Forego remainder of initialization if not using this scheme @@ -216,22 +216,22 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) if (present(passive)) passive=CS%passiveMode ! This is passed back to the caller so ! the caller knows to not use KPP output call get_param(paramFile, mdl, 'APPLY_NONLOCAL_TRANSPORT', CS%applyNonLocalTrans, & - 'If True, applies the non-local transport to heat and scalars.\n'// & - 'If False, calculates the non-local transport and tendencies but\n'//& + 'If True, applies the non-local transport to heat and scalars. '// & + 'If False, calculates the non-local transport and tendencies but '//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) call get_param(paramFile, mdl, 'N_SMOOTH', CS%n_smooth, & - 'The number of times the 1-1-4-1-1 Laplacian filter is applied on\n'// & + 'The number of times the 1-1-4-1-1 Laplacian filter is applied on '// & 'OBL depth.', & default=0) if (CS%n_smooth > 0) then call get_param(paramFile, mdl, 'DEEPEN_ONLY_VIA_SMOOTHING', CS%deepen_only, & - 'If true, apply OBLdepth smoothing at a cell only if the OBLdepth.\n'// & + 'If true, apply OBLdepth smoothing at a cell only if the OBLdepth '// & 'gets deeper via smoothing.', & default=.false.) endif call get_param(paramFile, mdl, 'RI_CRIT', CS%Ri_crit, & - 'Critical bulk Richardson number used to define depth of the\n'// & + 'Critical bulk Richardson number used to define depth of the '// & 'surface Ocean Boundary Layer (OBL).', & units='nondim', default=0.3) call get_param(paramFile, mdl, 'VON_KARMAN', CS%vonKarman, & @@ -252,7 +252,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'If True, limit OBL depth to be no deeper than Ekman depth.', & default=.False.) call get_param(paramFile, mdl, 'COMPUTE_MONIN_OBUKHOV', CS%computeMoninObukhov, & - 'If True, limit the OBL depth to be no deeper than\n'// & + 'If True, limit the OBL depth to be no deeper than '// & 'Monin-Obukhov depth.', & default=.False.) call get_param(paramFile, mdl, 'CS', CS%cs, & @@ -262,47 +262,47 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'Parameter for computing non-local term.', & units='nondim', default=6.32739901508) call get_param(paramFile, mdl, 'DEEP_OBL_OFFSET', CS%deepOBLoffset, & - 'If non-zero, the distance above the bottom to which the OBL is clipped\n'// & + 'If non-zero, the distance above the bottom to which the OBL is clipped '// & 'if it would otherwise reach the bottom. The smaller of this and 0.1D is used.', & units='m',default=0.) call get_param(paramFile, mdl, 'FIXED_OBLDEPTH', CS%fixedOBLdepth, & - 'If True, fix the OBL depth to FIXED_OBLDEPTH_VALUE\n'// & - 'rather than using the OBL depth from CVMix.\n'// & + 'If True, fix the OBL depth to FIXED_OBLDEPTH_VALUE '// & + 'rather than using the OBL depth from CVMix. '// & 'This option is just for testing purposes.', & default=.False.) call get_param(paramFile, mdl, 'FIXED_OBLDEPTH_VALUE', CS%fixedOBLdepth_value, & - 'Value for the fixed OBL depth when fixedOBLdepth==True. \n'// & - 'This parameter is for just for testing purposes. \n'// & + 'Value for the fixed OBL depth when fixedOBLdepth==True. '// & + 'This parameter is for just for testing purposes. '// & 'It will over-ride the OBLdepth computed from CVMix.', & units='m',default=30.0) call get_param(paramFile, mdl, 'SURF_LAYER_EXTENT', CS%surf_layer_ext, & 'Fraction of OBL depth considered in the surface layer.', & units='nondim',default=0.10) call get_param(paramFile, mdl, 'MINIMUM_OBL_DEPTH', CS%minOBLdepth, & - 'If non-zero, a minimum depth to use for KPP OBL depth. Independent of\n'// & + 'If non-zero, a minimum depth to use for KPP OBL depth. Independent of '// & 'this parameter, the OBL depth is always at least as deep as the first layer.', & units='m',default=0.) call get_param(paramFile, mdl, 'MINIMUM_VT2', CS%minVtsqr, & - 'Min of the unresolved velocity Vt2 used in Rib CVMix calculation. \n'// & + 'Min of the unresolved velocity Vt2 used in Rib CVMix calculation.\n'// & 'Scaling: MINIMUM_VT2 = const1*d*N*ws, with d=1m, N=1e-5/s, ws=1e-6 m/s.', & units='m2/s2',default=1e-10) ! smg: for removal below call get_param(paramFile, mdl, 'CORRECT_SURFACE_LAYER_AVERAGE', CS%correctSurfLayerAvg, & - 'If true, applies a correction step to the averaging of surface layer\n'// & + 'If true, applies a correction step to the averaging of surface layer '// & 'properties. This option is obsolete.', default=.False.) if (CS%correctSurfLayerAvg) & call MOM_error(FATAL,'Correct surface layer average disabled in code. To recover \n'// & ' feature will require code intervention.') call get_param(paramFile, mdl, 'FIRST_GUESS_SURFACE_LAYER_DEPTH', CS%surfLayerDepth, & - 'The first guess at the depth of the surface layer used for averaging\n'// & - 'the surface layer properties. If =0, the top model level properties\n'// & - 'will be used for the surface layer. If CORRECT_SURFACE_LAYER_AVERAGE=True, a\n'// & + 'The first guess at the depth of the surface layer used for averaging '// & + 'the surface layer properties. If =0, the top model level properties '// & + 'will be used for the surface layer. If CORRECT_SURFACE_LAYER_AVERAGE=True, a '// & 'subsequent correction is applied. This parameter is obsolete', units='m', default=0.) ! smg: for removal above call get_param(paramFile, mdl, 'NLT_SHAPE', string, & - 'MOM6 method to set nonlocal transport profile.\n'// & + 'MOM6 method to set nonlocal transport profile. '// & 'Over-rides the result from CVMix. Allowed values are: \n'// & '\t CVMix - Uses the profiles from CVMix specified by MATCH_TECHNIQUE\n'//& '\t LINEAR - A linear profile, 1-sigma\n'// & @@ -320,7 +320,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) "Unrecognized NLT_SHAPE option"//trim(string)) end select call get_param(paramFile, mdl, 'MATCH_TECHNIQUE', CS%MatchTechnique, & - 'CVMix method to set profile function for diffusivity and NLT,\n'// & + 'CVMix method to set profile function for diffusivity and NLT, '// & 'as well as matching across OBL base. Allowed values are: \n'// & '\t SimpleShapes = sigma*(1-sigma)^2 for both diffusivity and NLT\n'// & '\t MatchGradient = sigma*(1-sigma)^2 for NLT; diffusivity profile from matching\n'//& @@ -353,7 +353,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'If false, KPP is the only diffusivity wherever KPP is non-zero.', & default=.True.) call get_param(paramFile, mdl, 'KPP_SHORTWAVE_METHOD',string, & - 'Determines contribution of shortwave radiation to KPP surface \n'// & + 'Determines contribution of shortwave radiation to KPP surface '// & 'buoyancy flux. Options include:\n'// & ' ALL_SW: use total shortwave radiation\n'// & ' MXL_SW: use shortwave radiation absorbed by mixing layer\n'// & @@ -367,7 +367,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) "Unrecognized KPP_SHORTWAVE_METHOD option"//trim(string)) end select call get_param(paramFile, mdl, 'CVMix_ZERO_H_WORK_AROUND', CS%min_thickness, & - 'A minimum thickness used to avoid division by small numbers in the vicinity\n'// & + 'A minimum thickness used to avoid division by small numbers in the vicinity '// & 'of vanished layers. This is independent of MIN_THICKNESS used in other parts of MOM.', & units='m', default=0.) @@ -381,7 +381,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'mixing coefficient.', units="", Default=.false.) if (CS%LT_K_Enhancement) then call get_param(paramFile, mdl, 'KPP_LT_K_SHAPE', string, & - 'Vertical dependence of LT enhancement of mixing. \n'// & + 'Vertical dependence of LT enhancement of mixing. '// & 'Valid options are: \n'// & '\t CONSTANT = Constant value for full OBL\n'// & '\t SCALED = Varies based on normalized shape function.', & @@ -393,7 +393,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) "Unrecognized KPP_LT_K_SHAPE option: "//trim(string)) end select call get_param(paramFile, mdl, "KPP_LT_K_METHOD", string , & - 'Method to enhance mixing coefficient in KPP. \n'// & + 'Method to enhance mixing coefficient in KPP. '// & 'Valid options are: \n'// & '\t CONSTANT = Constant value (KPP_K_ENH_FAC) \n'// & '\t VR12 = Function of Langmuir number based on VR12\n'// & @@ -418,7 +418,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'in Bulk Richardson Number.', units="", Default=.false.) if (CS%LT_Vt2_Enhancement) then call get_param(paramFile, mdl, "KPP_LT_VT2_METHOD",string , & - 'Method to enhance Vt2 in KPP. \n'// & + 'Method to enhance Vt2 in KPP. '// & 'Valid options are: \n'// & '\t CONSTANT = Constant value (KPP_VT2_ENH_FAC) \n'// & '\t VR12 = Function of Langmuir number based on VR12\n'// & diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 19327cd007..1a9cb890ef 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -79,9 +79,9 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, & "Parameterization of enhanced mixing due to convection via CVMix") call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, & - "If true, turns on the enhanced mixing due to convection \n"// & - "via CVMix. This scheme increases diapycnal diffs./viscs. \n"// & - " at statically unstable interfaces. Relevant parameters are \n"// & + "If true, turns on the enhanced mixing due to convection "//& + "via CVMix. This scheme increases diapycnal diffs./viscs. "//& + "at statically unstable interfaces. Relevant parameters are "//& "contained in the CVMix_CONVECTION% parameter block.", & default=.false.) @@ -105,17 +105,17 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call openParameterBlock(param_file,'CVMix_CONVECTION') call get_param(param_file, mdl, "PRANDTL_CONV", prandtl_conv, & - "The turbulent Prandtl number applied to convective \n"//& + "The turbulent Prandtl number applied to convective "//& "instabilities (i.e., used to convert KD_CONV into KV_CONV)", & units="nondim", default=1.0) call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv_const, & - "Diffusivity used in convective regime. Corresponding viscosity \n" // & + "Diffusivity used in convective regime. Corresponding viscosity "//& "(KV_CONV) will be set to KD_CONV * PRANDTL_TURB.", & units='m2/s', default=1.00) call get_param(param_file, mdl, 'BV_SQR_CONV', CS%bv_sqr_conv, & - "Threshold for squared buoyancy frequency needed to trigger \n" // & + "Threshold for squared buoyancy frequency needed to trigger "//& "Brunt-Vaisala parameterization.", & units='1/s^2', default=0.0) diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 0e80f166c5..4f535197a7 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -82,9 +82,9 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, & "Parameterization of mixing due to double diffusion processes via CVMix") call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_init, & - "If true, turns on double diffusive processes via CVMix. \n"// & - "Note that double diffusive processes on viscosity are ignored \n"// & - "in CVMix, see http://cvmix.github.io/ for justification.",& + "If true, turns on double diffusive processes via CVMix. "//& + "Note that double diffusive processes on viscosity are ignored "//& + "in CVMix, see http://cvmix.github.io/ for justification.", & default=.false.) if (.not. CVMix_ddiff_init) return @@ -100,7 +100,7 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) units="nondim", default=2.55) call get_param(param_file, mdl, "KAPPA_DDIFF_S", CS%kappa_ddiff_s, & - "Leading coefficient in formula for salt-fingering regime \n"// & + "Leading coefficient in formula for salt-fingering regime "//& "for salinity diffusion.", units="m2 s-1", default=1.0e-4) call get_param(param_file, mdl, "DDIFF_EXP1", CS%ddiff_exp1, & diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 06fa74bdc7..9e0f6ca708 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -213,14 +213,14 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, & "Parameterization of shear-driven turbulence via CVMix (various options)") call get_param(param_file, mdl, "USE_LMD94", CS%use_LMD94, & - "If true, use the Large-McWilliams-Doney (JGR 1994) \n"//& + "If true, use the Large-McWilliams-Doney (JGR 1994) "//& "shear mixing parameterization.", default=.false.) if (CS%use_LMD94) then NumberTrue=NumberTrue + 1 CS%Mix_Scheme='KPP' endif call get_param(param_file, mdl, "USE_PP81", CS%use_PP81, & - "If true, use the Pacanowski and Philander (JPO 1981) \n"//& + "If true, use the Pacanowski and Philander (JPO 1981) "//& "shear mixing parameterization.", default=.false.) if (CS%use_PP81) then NumberTrue = NumberTrue + 1 @@ -243,16 +243,16 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) "Leading coefficient in KPP shear mixing.", & units="nondim", default=5.e-3) call get_param(param_file, mdl, "RI_ZERO", CS%Ri_Zero, & - "Critical Richardson for KPP shear mixing,"// & - " NOTE this the internal mixing and this is"// & - " not for setting the boundary layer depth." & + "Critical Richardson for KPP shear mixing, "// & + "NOTE this the internal mixing and this is "// & + "not for setting the boundary layer depth." & ,units="nondim", default=0.8) call get_param(param_file, mdl, "KPP_EXP", CS%KPP_exp, & - "Exponent of unitless factor of diffusivities,"// & - " for KPP internal shear mixing scheme." & + "Exponent of unitless factor of diffusivities, "// & + "for KPP internal shear mixing scheme." & ,units="nondim", default=3.0) call get_param(param_file, mdl, "SMOOTH_RI", CS%smooth_ri, & - "If true, vertically smooth the Richardson"// & + "If true, vertically smooth the Richardson "// & "number by applying a 1-2-1 filter once.", & default = .false.) call cvmix_init_shear(mix_scheme=CS%Mix_Scheme, & diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 7bf23fa63e..e941ec3eea 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -144,12 +144,12 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "Adding static vertical background mixing coefficients") call get_param(param_file, mdl, "KD", CS%Kd, & - "The background diapycnal diffusivity of density in the \n"//& - "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& + "The background diapycnal diffusivity of density in the "//& + "interior. Zero or the molecular value, ~1e-7 m2 s-1, "//& "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KV", Kv, & - "The background kinematic viscosity in the interior. \n"//& + "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) @@ -172,13 +172,13 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) ! cannot be a NaN. else call get_param(param_file, mdl, "KDML", CS%Kdml, & - "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& - "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& + "If BULKMIXEDLAYER is false, KDML is the elevated "//& + "diapycnal diffusivity in the topmost HMIX of fluid. "//& "KDML is only used if BULKMIXEDLAYER is false.", & units="m2 s-1", default=CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & - "The prescribed depth over which the near-surface \n"//& - "viscosity and diffusivity are elevated when the bulk \n"//& + "The prescribed depth over which the near-surface "//& + "viscosity and diffusivity are elevated when the bulk "//& "mixed layer is not used.", units="m", scale=US%m_to_Z, fail_if_missing=.true.) endif @@ -186,10 +186,9 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) ! call openParameterBlock(param_file,'MOM_BACKGROUND_MIXING') - call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", & - CS%Bryan_Lewis_diffusivity, & - "If true, use a Bryan & Lewis (JGR 1979) like tanh \n"//& - "profile of background diapycnal diffusivity with depth. \n"//& + call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", CS%Bryan_Lewis_diffusivity, & + "If true, use a Bryan & Lewis (JGR 1979) like tanh "//& + "profile of background diapycnal diffusivity with depth. "//& "This is done via CVMix.", default=.false.) if (CS%Bryan_Lewis_diffusivity) then @@ -219,7 +218,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", & CS%horiz_varying_background, & - "If true, apply vertically uniform, latitude-dependent background\n"//& + "If true, apply vertically uniform, latitude-dependent background "//& "diffusivity, as described in Danabasoglu et al., 2012", & default=.false.) @@ -248,7 +247,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) endif call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & - "Turbulent Prandtl number used to convert vertical \n"//& + "Turbulent Prandtl number used to convert vertical "//& "background diffusivities into viscosities.", & units="nondim", default=1.0) @@ -265,18 +264,16 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) endif - call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND", & - CS%Henyey_IGW_background, & - "If true, use a latitude-dependent scaling for the near \n"//& - "surface background diffusivity, as described in \n"//& + call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND", CS%Henyey_IGW_background, & + "If true, use a latitude-dependent scaling for the near "//& + "surface background diffusivity, as described in "//& "Harrison & Hallberg, JPO 2008.", default=.false.) if (CS%Henyey_IGW_background) call check_bkgnd_scheme(CS, "HENYEY_IGW_BACKGROUND") - call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND_NEW", & - CS%Henyey_IGW_background_new, & - "If true, use a better latitude-dependent scaling for the\n"//& - "background diffusivity, as described in \n"//& + call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND_NEW", CS%Henyey_IGW_background_new, & + "If true, use a better latitude-dependent scaling for the "//& + "background diffusivity, as described in "//& "Harrison & Hallberg, JPO 2008.", default=.false.) if (CS%Henyey_IGW_background_new) call check_bkgnd_scheme(CS, "HENYEY_IGW_BACKGROUND_NEW") @@ -288,22 +285,21 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%Henyey_IGW_background) & call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & - "The ratio of the typical Buoyancy frequency to twice \n"//& - "the Earth's rotation period, used with the Henyey \n"//& + "The ratio of the typical Buoyancy frequency to twice "//& + "the Earth's rotation period, used with the Henyey "//& "scaling from the mixing.", units="nondim", default=20.0) call get_param(param_file, mdl, "KD_TANH_LAT_FN", & CS%Kd_tanh_lat_fn, & - "If true, use a tanh dependence of Kd_sfc on latitude, \n"//& - "like CM2.1/CM2M. There is no physical justification \n"//& - "for this form, and it can not be used with \n"//& + "If true, use a tanh dependence of Kd_sfc on latitude, "//& + "like CM2.1/CM2M. There is no physical justification "//& + "for this form, and it can not be used with "//& "HENYEY_IGW_BACKGROUND.", default=.false.) if (CS%Kd_tanh_lat_fn) & - call get_param(param_file, mdl, "KD_TANH_LAT_SCALE", & - CS%Kd_tanh_lat_scale, & - "A nondimensional scaling for the range ofdiffusivities \n"//& - "with KD_TANH_LAT_FN. Valid values are in the range of \n"//& + call get_param(param_file, mdl, "KD_TANH_LAT_SCALE", CS%Kd_tanh_lat_scale, & + "A nondimensional scaling for the range ofdiffusivities "//& + "with KD_TANH_LAT_FN. Valid values are in the range of "//& "-2 to 2; 0.4 reproduces CM2M.", units="nondim", default=0.0) if (CS%Henyey_IGW_background .and. CS%Kd_tanh_lat_fn) call MOM_error(FATAL, & diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index fefb4e8daf..17b7bb5c15 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -3429,81 +3429,81 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) CS%nkml = GV%nkml call log_param(param_file, mdl, "NKML", CS%nkml, & - "The number of sublayers within the mixed layer if \n"//& + "The number of sublayers within the mixed layer if "//& "BULKMIXEDLAYER is true.", units="nondim", default=2) CS%nkbl = GV%nk_rho_varies - GV%nkml call log_param(param_file, mdl, "NKBL", CS%nkbl, & - "The number of variable density buffer layers if \n"//& + "The number of variable density buffer layers if "//& "BULKMIXEDLAYER is true.", units="nondim", default=2) call get_param(param_file, mdl, "MSTAR", CS%mstar, & - "The ratio of the friction velocity cubed to the TKE \n"//& + "The ratio of the friction velocity cubed to the TKE "//& "input to the mixed layer.", "units=nondim", default=1.2) call get_param(param_file, mdl, "NSTAR", CS%nstar, & - "The portion of the buoyant potential energy imparted by \n"//& - "surface fluxes that is available to drive entrainment \n"//& + "The portion of the buoyant potential energy imparted by "//& + "surface fluxes that is available to drive entrainment "//& "at the base of mixed layer when that energy is positive.", & units="nondim", default=0.15) call get_param(param_file, mdl, "BULK_RI_ML", CS%bulk_Ri_ML, & - "The efficiency with which mean kinetic energy released \n"//& - "by mechanically forced entrainment of the mixed layer \n"//& + "The efficiency with which mean kinetic energy released "//& + "by mechanically forced entrainment of the mixed layer "//& "is converted to turbulent kinetic energy.", units="nondim",& fail_if_missing=.true.) call get_param(param_file, mdl, "ABSORB_ALL_SW", CS%absorb_all_sw, & - "If true, all shortwave radiation is absorbed by the \n"//& + "If true, all shortwave radiation is absorbed by the "//& "ocean, instead of passing through to the bottom mud.", & default=.false.) call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & - "TKE_DECAY relates the vertical rate of decay of the \n"//& - "TKE available for mechanical entrainment to the natural \n"//& + "TKE_DECAY relates the vertical rate of decay of the "//& + "TKE available for mechanical entrainment to the natural "//& "Ekman depth.", units="nondim", default=2.5) call get_param(param_file, mdl, "NSTAR2", CS%nstar2, & - "The portion of any potential energy released by \n"//& - "convective adjustment that is available to drive \n"//& - "entrainment at the base of mixed layer. By default \n"//& + "The portion of any potential energy released by "//& + "convective adjustment that is available to drive "//& + "entrainment at the base of mixed layer. By default "//& "NSTAR2=NSTAR.", units="nondim", default=CS%nstar) call get_param(param_file, mdl, "BULK_RI_CONVECTIVE", CS%bulk_Ri_convective, & - "The efficiency with which convectively released mean \n"//& - "kinetic energy is converted to turbulent kinetic \n"//& + "The efficiency with which convectively released mean "//& + "kinetic energy is converted to turbulent kinetic "//& "energy. By default BULK_RI_CONVECTIVE=BULK_RI_ML.", & units="nondim", default=CS%bulk_Ri_ML) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & - "The minimum mixed layer depth if the mixed layer depth \n"//& + "The minimum mixed layer depth if the mixed layer depth "//& "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, & unscaled=Hmix_min_m) call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & - "If true, limit the detrainment from the buffer layers \n"//& + "If true, limit the detrainment from the buffer layers "//& "to not be too different from the neighbors.", default=.false.) call get_param(param_file, mdl, "ALLOWED_DETRAIN_TEMP_CHG", CS%Allowed_T_chg, & - "The amount by which temperature is allowed to exceed \n"//& + "The amount by which temperature is allowed to exceed "//& "previous values during detrainment.", units="K", default=0.5) call get_param(param_file, mdl, "ALLOWED_DETRAIN_SALT_CHG", CS%Allowed_S_chg, & - "The amount by which salinity is allowed to exceed \n"//& + "The amount by which salinity is allowed to exceed "//& "previous values during detrainment.", units="PSU", default=0.1) call get_param(param_file, mdl, "ML_DT_DS_WEIGHT", CS%dT_dS_wt, & - "When forced to extrapolate T & S to match the layer \n"//& - "densities, this factor (in deg C / PSU) is combined \n"//& - "with the derivatives of density with T & S to determine \n"//& - "what direction is orthogonal to density contours. It \n"//& - "should be a typical value of (dR/dS) / (dR/dT) in \n"//& + "When forced to extrapolate T & S to match the layer "//& + "densities, this factor (in deg C / PSU) is combined "//& + "with the derivatives of density with T & S to determine "//& + "what direction is orthogonal to density contours. It "//& + "should be a typical value of (dR/dS) / (dR/dT) in "//& "oceanic profiles.", units="degC PSU-1", default=6.0) call get_param(param_file, mdl, "BUFFER_LAYER_EXTRAP_LIMIT", CS%BL_extrap_lim, & - "A limit on the density range over which extrapolation \n"//& - "can occur when detraining from the buffer layers, \n"//& - "relative to the density range within the mixed and \n"//& - "buffer layers, when the detrainment is going into the \n"//& - "lightest interior layer, nondimensional, or a negative \n"//& + "A limit on the density range over which extrapolation "//& + "can occur when detraining from the buffer layers, "//& + "relative to the density range within the mixed and "//& + "buffer layers, when the detrainment is going into the "//& + "lightest interior layer, nondimensional, or a negative "//& "value not to apply this limit.", units="nondim", default = -1.0) call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & - "The surface fluxes are scaled away when the total ocean \n"//& + "The surface fluxes are scaled away when the total ocean "//& "depth is less than DEPTH_LIMIT_FLUXES.", & units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) call get_param(param_file, mdl, "OMEGA",CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & - "If true, use the absolute rotation rate instead of the \n"//& - "vertical component of rotation when setting the decay \n"//& + "If true, use the absolute rotation rate instead of the "//& + "vertical component of rotation when setting the decay "//& "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then @@ -3511,58 +3511,58 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) omega_frac_dflt = 1.0 endif call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & - "When setting the decay scale for turbulence, use this \n"//& - "fraction of the absolute rotation rate blended with the \n"//& + "When setting the decay scale for turbulence, use this "//& + "fraction of the absolute rotation rate blended with the "//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "ML_RESORT", CS%ML_resort, & - "If true, resort the topmost layers by potential density \n"//& + "If true, resort the topmost layers by potential density "//& "before the mixed layer calculations.", default=.false.) if (CS%ML_resort) & call get_param(param_file, mdl, "ML_PRESORT_NK_CONV_ADJ", CS%ML_presort_nz_conv_adj, & - "Convectively mix the first ML_PRESORT_NK_CONV_ADJ \n"//& + "Convectively mix the first ML_PRESORT_NK_CONV_ADJ "//& "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & - "The minimum value of ustar that should be used by the \n"//& - "bulk mixed layer model in setting vertical TKE decay \n"//& + "The minimum value of ustar that should be used by the "//& + "bulk mixed layer model in setting vertical TKE decay "//& "scales. This must be greater than 0.", units="m s-1", & default=ustar_min_dflt, scale=US%m_to_Z) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & - "If true, the NKML>1 layers in the mixed layer are \n"//& - "chosen to optimally represent the impact of the Ekman \n"//& - "transport on the mixed layer TKE budget. Otherwise, \n"//& - "the sublayers are distributed uniformly through the \n"//& + "If true, the NKML>1 layers in the mixed layer are "//& + "chosen to optimally represent the impact of the Ekman "//& + "transport on the mixed layer TKE budget. Otherwise, "//& + "the sublayers are distributed uniformly through the "//& "mixed layer.", default=.false.) call get_param(param_file, mdl, "CORRECT_ABSORPTION_DEPTH", CS%correct_absorption, & - "If true, the average depth at which penetrating shortwave \n"//& - "radiation is absorbed is adjusted to match the average \n"//& - "heating depth of an exponential profile by moving some \n"//& + "If true, the average depth at which penetrating shortwave "//& + "radiation is absorbed is adjusted to match the average "//& + "heating depth of an exponential profile by moving some "//& "of the heating upward in the water column.", default=.false.) call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & - "If true, apply additional mixing wherever there is \n"//& - "runoff, so that it is mixed down to RIVERMIX_DEPTH, \n"//& + "If true, apply additional mixing wherever there is "//& + "runoff, so that it is mixed down to RIVERMIX_DEPTH, "//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & - "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& + "The depth to which rivers are mixed if DO_RIVERMIX is "//& "defined.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & - "If true, use the fluxes%runoff_Hflx field to set the \n"//& + "If true, use the fluxes%runoff_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & default=.false.) call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & - "If true, use the fluxes%calving_Hflx field to set the \n"//& + "If true, use the fluxes%calving_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & 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 \n"//& + "If true, clocks can be called from inside loops that can "//& "be threaded. To run with multiple threads, set to False.", & default=.true.) @@ -3602,17 +3602,17 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & - "The fractional limit in the change between grid points \n"//& + "The fractional limit in the change between grid points "//& "of the surface region (mixed & buffer layer) thickness.", & units="nondim", default=0.5) call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_BATHY", CS%lim_det_dH_bathy, & - "The fraction of the total depth by which the thickness \n"//& - "of the surface region (mixed & buffer layer) is allowed \n"//& + "The fraction of the total depth by which the thickness "//& + "of the surface region (mixed & buffer layer) is allowed "//& "to change between grid points.", units="nondim", default=0.2) endif call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & - "If true, temperature and salinity are used as state \n"//& + "If true, temperature and salinity are used as state "//& "variables.", default=.true.) CS%nsw = 0 if (use_temperature) then diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 835a3ff450..5259d4ed25 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1337,31 +1337,31 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori "The following parameters are used for auxiliary diabatic processes.") call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & - "If true, try to use any frazil heat deficit to cool any\n"//& - "overlying layers down to the freezing point, thereby \n"//& - "avoiding the creation of thin ice when the SST is above \n"//& + "If true, try to use any frazil heat deficit to cool any "//& + "overlying layers down to the freezing point, thereby "//& + "avoiding the creation of thin ice when the SST is above "//& "the freezing point.", default=.true.) call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", & CS%pressure_dependent_frazil, & - "If true, use a pressure dependent freezing temperature \n"//& - "when making frazil. The default is false, which will be \n"//& + "If true, use a pressure dependent freezing temperature "//& + "when making frazil. The default is false, which will be "//& "faster but is inappropriate with ice-shelf cavities.", & default=.false.) if (use_ePBL) then call get_param(param_file, mdl, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& - "If true, the model does not check if fluxes are being applied\n"//& - "over land points. This is needed when the ocean is coupled \n"//& - "with ice shelves and sea ice, since the sea ice mask needs to \n"//& - "be different than the ocean mask to avoid sea ice formation \n"//& + "If true, the model does not check if fluxes are being applied "//& + "over land points. This is needed when the ocean is coupled "//& + "with ice shelves and sea ice, since the sea ice mask needs to "//& + "be different than the ocean mask to avoid sea ice formation "//& "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & - "If true, apply additional mixing wherever there is \n"//& - "runoff, so that it is mixed down to RIVERMIX_DEPTH \n"//& + "If true, apply additional mixing wherever there is "//& + "runoff, so that it is mixed down to RIVERMIX_DEPTH "//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & - "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& + "The depth to which rivers are mixed if DO_RIVERMIX is "//& "defined.", units="m", default=0.0, scale=US%m_to_Z) else CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; CS%ignore_fluxes_over_land = .false. @@ -1369,11 +1369,11 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori if (GV%nkml == 0) then call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & - "If true, use the fluxes%runoff_Hflx field to set the \n"//& + "If true, use the fluxes%runoff_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & default=.false.) call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & - "If true, use the fluxes%calving_Hflx field to set the \n"//& + "If true, use the fluxes%calving_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & default=.false.) else diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 0e20d6883e..8f4e28cbc4 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2825,27 +2825,27 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& - "specified via calls to initialize_sponge and possibly \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& + "specified via calls to initialize_sponge and possibly "//& "set_up_sponge_field.", default=.false.) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & - "If true, temperature and salinity are used as state \n"//& + "If true, temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & - "If true, use an implied energetics planetary boundary \n"//& - "layer scheme to determine the diffusivity and viscosity \n"//& + "If true, use an implied energetics planetary boundary "//& + "layer scheme to determine the diffusivity and viscosity "//& "in the surface boundary layer.", default=.false.) call get_param(param_file, mdl, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, & - "If true, the diffusivity from ePBL is added to all\n"//& - "other diffusivities. Otherwise, the larger of kappa-\n"//& - "shear and ePBL diffusivities are used.", default=.true.) + "If true, the diffusivity from ePBL is added to all "//& + "other diffusivities. Otherwise, the larger of kappa-shear "//& + "and ePBL diffusivities are used.", default=.true.) call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differentialDiffusion, & "If true, apply parameterization of double-diffusion.", & default=.false. ) call get_param(param_file, mdl, "USE_KPP", CS%use_KPP, & - "If true, turns on the [CVMix] KPP scheme of Large et al., 1994,\n"// & - "to calculate diffusivities and non-local transport in the OBL.", & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "//& + "to calculate diffusivities and non-local transport in the OBL.", & default=.false., do_not_log=.true.) CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) @@ -2860,7 +2860,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%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 \n"//& + "The fraction of the mixed layer mixing that is applied "//& "before interior diapycnal mixing. 0 by default.", & units="nondim", default=0.0) call get_param(param_file, mdl, "NKBL", CS%nkbl, default=2, do_not_log=.true.) @@ -2874,13 +2874,13 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%use_geothermal = .false. endif call get_param(param_file, mdl, "INTERNAL_TIDES", CS%use_int_tides, & - "If true, use the code that advances a separate set of \n"//& + "If true, use the code that advances a separate set of "//& "equations for the internal tide energy density.", default=.false.) CS%nMode = 1 if (CS%use_int_tides) then ! SET NUMBER OF MODES TO CONSIDER call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & - "The number of distinct internal tide modes \n"//& + "The number of distinct internal tide modes "//& "that will be calculated.", default=1, do_not_log=.true.) ! The following parameters are used in testing the internal tide code. @@ -2909,17 +2909,17 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & CS%massless_match_targets, & - "If true, the temperature and salinity of massless layers \n"//& - "are kept consistent with their target densities. \n"//& - "Otherwise the properties of massless layers evolve \n"//& + "If true, the temperature and salinity of massless layers "//& + "are kept consistent with their target densities. "//& + "Otherwise the properties of massless layers evolve "//& "diffusively to match massive neighboring layers.", & default=.true.) call get_param(param_file, mdl, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & - "If true, the net incoming and outgoing fresh water fluxes are combined \n"//& - "and applied as either incoming or outgoing depending on the sign of the net. \n"//& - "If false, the net incoming fresh water flux is added to the model and \n"//& - "thereafter the net outgoing is removed from the topmost non-vanished \n"//& + "If true, the net incoming and outgoing fresh water fluxes are combined "//& + "and applied as either incoming or outgoing depending on the sign of the net. "//& + "If false, the net incoming fresh water flux is added to the model and "//& + "thereafter the net outgoing is removed from the topmost non-vanished "//& "layers of the updated state.", default=.true.) call get_param(param_file, mdl, "DEBUG", CS%debug, & @@ -2932,36 +2932,36 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "DEBUG_ENERGY_REQ", CS%debug_energy_req, & "If true, debug the energy requirements.", default=.false., do_not_log=.true.) call get_param(param_file, mdl, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, & - "If true, mix the passive tracers in massless layers at \n"//& - "the bottom into the interior as though a diffusivity of \n"//& + "If true, mix the passive tracers in massless layers at "//& + "the bottom into the interior as though a diffusivity of "//& "KD_MIN_TR were operating.", default=.true.) if (CS%mix_boundary_tracers) then call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & - "A minimal diffusivity that should always be applied to \n"//& - "tracers, especially in massless layers near the bottom. \n"//& + "A minimal diffusivity that should always be applied to "//& + "tracers, especially in massless layers near the bottom. "//& "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m_to_Z**2) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & - "A bottom boundary layer tracer diffusivity that will \n"//& - "allow for explicitly specified bottom fluxes. The \n"//& - "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& + "A bottom boundary layer tracer diffusivity that will "//& + "allow for explicitly specified bottom fluxes. The "//& + "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) "//& "over the same distance.", units="m2 s-1", default=0., scale=US%m_to_Z**2) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & - "If true, use the passive tracer tridiagonal solver for T and S\n", & + "If true, use the passive tracer tridiagonal solver for T and S", & default=.false.) call get_param(param_file, mdl, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, & - "The smallest depth over which forcing can be applied. This\n"//& - "only takes effect when near-surface layers become thin\n"//& - "relative to this scale, in which case the forcing tendencies\n"//& + "The smallest depth over which forcing can be applied. This "//& + "only takes effect when near-surface layers become thin "//& + "relative to this scale, in which case the forcing tendencies "//& "scaled down by distributing the forcing over this depth scale.", & units="m", default=0.001) call get_param(param_file, mdl, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, & - "The largest fraction of a layer than can be lost to forcing\n"//& - "(e.g. evaporation, sea-ice formation) in one time-step. The unused\n"//& + "The largest fraction of a layer than can be lost to forcing "//& + "(e.g. evaporation, sea-ice formation) in one time-step. The unused "//& "mass loss is passed down through the column.", & units="nondim", default=0.8) @@ -3032,12 +3032,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & - "The density difference used to determine a diagnostic mixed\n"//& - "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& - "The MLD is the depth at which the density is larger than the\n"//& + "The density difference used to determine a diagnostic mixed "//& + "layer depth, MLD_user, following the definition of Levitus 1982. "//& + "The MLD is the depth at which the density is larger than the "//& "surface density by the specified amount.", units='kg/m3', default=0.1) call get_param(param_file, mdl, "DIAG_DEPTH_SUBML_N2", CS%dz_subML_N2, & - "The distance over which to calculate a diagnostic of the \n"//& + "The distance over which to calculate a diagnostic of the "//& "stratification at the base of the mixed layer.", & units='m', default=50.0, scale=US%m_to_Z) @@ -3123,7 +3123,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif call get_param(param_file, mdl, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & - "If true, place salt from brine rejection below the mixed layer,\n"// & + "If true, place salt from brine rejection below the mixed layer, "// & "into the first non-vanished layer for which the column remains stable", & default=.false.) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 5c9d06e96f..3d9fb3c6c7 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -1291,14 +1291,14 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, 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, "ENERGY_REQ_KH_SCALING", CS%test_Kh_scaling, & - "A scaling factor for the diapycnal diffusivity used in \n"//& + "A scaling factor for the diapycnal diffusivity used in "//& "testing the energy requirements.", default=1.0, units="nondim") call get_param(param_file, mdl, "ENERGY_REQ_COL_HT_SCALING", CS%ColHt_scaling, & - "A scaling factor for the column height change correction \n"//& + "A scaling factor for the column height change correction "//& "used in testing the energy requirements.", default=1.0, units="nondim") call get_param(param_file, mdl, "ENERGY_REQ_USE_TEST_PROFILE", & CS%use_test_Kh_profile, & - "If true, use the internal test diffusivity profile in \n"//& + "If true, use the internal test diffusivity profile in "//& "place of any that might be passed in as an argument.", default=.false.) CS%id_ERt = register_diag_field('ocean_model', 'EnReqTest_ERt', diag%axesZi, Time, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7f8d08fb48..303f700deb 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2048,68 +2048,68 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) " 2 for MSTAR w/ L_E/L_O in stabilizing limit.",& "units=nondim",default=0) call get_param(param_file, mdl, "MSTAR", CS%mstar, & - "The ratio of the friction velocity cubed to the TKE \n"//& + "The ratio of the friction velocity cubed to the TKE "//& "input to the mixed layer.", "units=nondim", default=1.2) call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & - "The exponent applied to the ratio of the distance to the MLD \n"//& + "The exponent applied to the ratio of the distance to the MLD "//& "and the MLD depth which determines the shape of the mixing length.",& "units=nondim", default=2.0) call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & - "Maximum value of mstar allowed in model if non-negative\n"//& + "Maximum value of mstar allowed in model if non-negative "//& "(used if MSTAR_MODE>0).",& "units=nondim", default=-1.0) call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%cnv_mst_fac, & - "Factor used for reducing mstar during convection \n"//& - " due to reduction of stable density gradient.",& + "Factor used for reducing mstar during convection "//& + "due to reduction of stable density gradient.",& "units=nondim", default=0.0) call get_param(param_file, mdl, "MSTAR_SLOPE", CS%mstar_slope, & - "The slope of the linear relationship between mstar \n"//& + "The slope of the linear relationship between mstar "//& "and the length scale ratio (used if MSTAR_MODE=1).",& "units=nondim", default=0.85) call get_param(param_file, mdl, "MSTAR_XINT", CS%mstar_xint, & - "The value of the length scale ratio where the mstar \n"//& + "The value of the length scale ratio where the mstar "//& "is linear above (used if MSTAR_MODE=1).",& "units=nondim", default=-0.3) call get_param(param_file, mdl, "MSTAR_AT_XINT", CS%mstar_at_xint, & - "The value of mstar at MSTAR_XINT \n"//& + "The value of mstar at MSTAR_XINT "//& "(used if MSTAR_MODE=1).",& "units=nondim", default=0.095) call get_param(param_file, mdl, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & - "Set false to use asymptotic cap, defaults to true.\n"//& + "Set false to use asymptotic cap, defaults to true. "//& "(used only if MSTAR_MODE=1)"& ,"units=nondim",default=.true.) call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & - "Coefficient in computing mstar when rotation and \n"//& - " stabilizing effects are both important (used if MSTAR_MODE=2)"& + "Coefficient in computing mstar when rotation and "//& + "stabilizing effects are both important (used if MSTAR_MODE=2)"& ,"units=nondim",default=0.3) call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & - "Coefficient in computing mstar when only rotation limits \n"//& - " the total mixing. (used only if MSTAR_MODE=2)"& + "Coefficient in computing mstar when only rotation limits "//& + "the total mixing. (used only if MSTAR_MODE=2)"& ,"units=nondim",default=0.085) call get_param(param_file, mdl, "NSTAR", CS%nstar, & - "The portion of the buoyant potential energy imparted by \n"//& - "surface fluxes that is available to drive entrainment \n"//& + "The portion of the buoyant potential energy imparted by "//& + "surface fluxes that is available to drive entrainment "//& "at the base of mixed layer when that energy is positive.", & units="nondim", default=0.2) call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & - "The efficiency with which mean kinetic energy released \n"//& - "by mechanically forced entrainment of the mixed layer \n"//& + "The efficiency with which mean kinetic energy released "//& + "by mechanically forced entrainment of the mixed layer "//& "is converted to turbulent kinetic energy.", units="nondim", & default=0.0) call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & - "TKE_DECAY relates the vertical rate of decay of the \n"//& - "TKE available for mechanical entrainment to the natural \n"//& + "TKE_DECAY relates the vertical rate of decay of the "//& + "TKE available for mechanical entrainment to the natural "//& "Ekman depth.", units="nondim", default=2.5) ! call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & -! "The minimum mixed layer depth if the mixed layer depth \n"//& +! "The minimum mixed layer depth if the mixed layer depth "//& ! "is determined dynamically.", units="m", default=0.0) call get_param(param_file, mdl, "OMEGA",CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & - "If true, use the absolute rotation rate instead of the \n"//& - "vertical component of rotation when setting the decay \n"// & + "If true, use the absolute rotation rate instead of the "//& + "vertical component of rotation when setting the decay "// & "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then @@ -2117,51 +2117,51 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) omega_frac_dflt = 1.0 endif call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & - "When setting the decay scale for turbulence, use this \n"// & - "fraction of the absolute rotation rate blended with the \n"//& + "When setting the decay scale for turbulence, use this "// & + "fraction of the absolute rotation rate blended with the "//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & - "A ratio relating the efficiency with which convectively \n"//& - "released energy is converted to a turbulent velocity, \n"// & - "relative to mechanically forced TKE. Making this larger \n"//& + "A ratio relating the efficiency with which convectively "//& + "released energy is converted to a turbulent velocity, "// & + "relative to mechanically forced TKE. Making this larger "//& "increases the BL diffusivity", units="nondim", default=1.0) call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & - "An overall nondimensional scaling factor for v*. \n"// & + "An overall nondimensional scaling factor for v*. "// & "Making this larger decreases the PBL diffusivity.", & units="nondim", default=1.0, scale=US%m_to_Z) call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & - "A nondimensional scaling factor controlling the inhibition \n"// & - "of the diffusive length scale by rotation. Making this larger \n"//& + "A nondimensional scaling factor controlling the inhibition "// & + "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.0) call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & - "A logical that specifies whether or not to use the \n"// & - "distance to the bottom of the actively turbulent boundary \n"//& + "A logical that specifies whether or not to use the "// & + "distance to the bottom of the actively turbulent boundary "//& "layer to help set the EPBL length scale.", default=.false.) call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & - "A logical that specifies whether or not to use the \n"// & - "old method for determining MLD depth in iteration, which \n"//& + "A logical that specifies whether or not to use the "// & + "old method for determining MLD depth in iteration, which "//& "is limited to resolution.", default=.true.) call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & - "A logical that specifies whether or not to use the \n"// & - "previous timestep MLD as a first guess in the MLD iteration.\n"// & + "A logical that specifies whether or not to use the "// & + "previous timestep MLD as a first guess in the MLD iteration. "// & "The default is false to facilitate reproducibility.", default=.false.) call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & - "The tolerance for the iteratively determined mixed \n"// & + "The tolerance for the iteratively determined mixed "// & "layer depth. This is only used with USE_MLD_ITERATION.", & units="meter", default=1.0, scale=US%m_to_Z) call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & - "The minimum mixing length scale that will be used \n"//& + "The minimum mixing length scale that will be used "//& "by ePBL. The default (0) does not set a minimum.", & units="meter", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & - "If true, the ePBL code uses the original form of the \n"// & - "potential energy change code. Otherwise, the newer \n"// & - "version that can work with successive increments to the \n"// & + "If true, the ePBL code uses the original form of the "// & + "potential energy change code. Otherwise, the newer "// & + "version that can work with successive increments to the "// & "diffusivity in upward or downward passes is used.", default=.true.) call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & - "A scale for the mixing length in the transition layer \n"// & - "at the edge of the boundary layer as a fraction of the \n"//& + "A scale for the mixing length in the transition layer "// & + "at the edge of the boundary layer as a fraction of the "//& "boundary layer thickness. The default is 0.1.", & units="nondim", default=0.1) if ( CS%USE_MLD_ITERATION .and. abs(CS%transLay_scale-0.5) >= 0.5) then @@ -2169,19 +2169,18 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "EPBL_TRANSITION should be greater than 0 and less than 1.") endif call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & - "A scale for the dissipation of TKE due to stratification \n"// & - "in the boundary layer, applied when local stratification \n"// & + "A scale for the dissipation of TKE due to stratification "// & + "in the boundary layer, applied when local stratification "// & "is positive. The default is 0, but should probably be ~0.4.", & units="nondim", default=0.0) call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& - "A scale for the dissipation of TKE due to stratification \n"// & - "in the boundary layer, applied when local stratification \n"// & + "A scale for the dissipation of TKE due to stratification "// & + "in the boundary layer, applied when local stratification "// & "is negative. The default is 0, but should probably be ~1.", & units="nondim", default=0.0) call get_param(param_file, mdl, "USE_LA_LI2016", USE_LA_Windsea, & - "A logical to use the Li et al. 2016 (submitted) formula to \n"//& - " determine the Langmuir number.", & - units="nondim", default=.false.) + "A logical to use the Li et al. 2016 (submitted) formula to "//& + "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. @@ -2206,30 +2205,30 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & units="nondim", default=-1.33) call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & - "Coefficient for modification of Langmuir number due to\n"//& - " MLD approaching Ekman depth if LT_ENHANCE=2.", & + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching Ekman depth if LT_ENHANCE=2.", & units="nondim", default=-0.87) call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & - "Coefficient for modification of Langmuir number due to\n"// & - " MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & + "Coefficient for modification of Langmuir number due to "// & + "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.0) call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & - "Coefficient for modification of Langmuir number due to\n"//& - " MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.0) call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & - "Coefficient for modification of Langmuir number due to\n"// & - " ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & + "Coefficient for modification of Langmuir number due to "// & + "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.95) call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & - "Coefficient for modification of Langmuir number due to\n"// & - " ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.",& + "Coefficient for modification of Langmuir number due to "// & + "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.",& units="nondim", default=0.95) endif ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m, & - "The (tiny) minimum friction velocity used within the \n"//& + "The (tiny) minimum friction velocity used within the "//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & @@ -2278,7 +2277,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'MSTAR applied for LT effect.', 'nondim') call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & - "If true, temperature and salinity are used as state \n"//& + "If true, temperature and salinity are used as state "//& "variables.", default=.true.) if (max(CS%id_TKE_wind, CS%id_TKE_MKE, CS%id_TKE_conv, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index e8916ce727..34b48257bb 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -2114,12 +2114,12 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "CORRECT_DENSITY", CS%correct_density, & - "If true, and USE_EOS is true, the layer densities are \n"//& - "restored toward their target values by the diapycnal \n"//& + "If true, and USE_EOS is true, the layer densities are "//& + "restored toward their target values by the diapycnal "//& "mixing, as described in Hallberg (MWR, 2000).", & default=.true.) call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, & - "The maximum number of iterations that may be used to \n"//& + "The maximum number of iterations that may be used to "//& "calculate the interior diapycnal entrainment.", default=5) ! In this module, KD is only used to set the default for TOLERANCE_ENT. [m2 s-1] call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 7ca06c6139..15f1116190 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -341,8 +341,8 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) ! write parameters to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "GEOTHERMAL_SCALE", scale, & - "The constant geothermal heat flux, a rescaling \n"//& - "factor for the heat flux read from GEOTHERMAL_FILE, or \n"//& + "The constant geothermal heat flux, a rescaling "//& + "factor for the heat flux read from GEOTHERMAL_FILE, or "//& "0 to disable the geothermal heating.", & units="W m-2 or various", default=0.0) CS%apply_geothermal = .not.(scale == 0.0) @@ -351,14 +351,14 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) call safe_alloc_ptr(CS%geo_heat, isd, ied, jsd, jed) ; CS%geo_heat(:,:) = 0.0 call get_param(param_file, mdl, "GEOTHERMAL_FILE", geo_file, & - "The file from which the geothermal heating is to be \n"//& + "The file from which the geothermal heating is to be "//& "read, or blank to use a constant heating rate.", default=" ") call get_param(param_file, mdl, "GEOTHERMAL_THICKNESS", CS%geothermal_thick, & "The thickness over which to apply geothermal heating.", & units="m", default=0.1) call get_param(param_file, mdl, "GEOTHERMAL_DRHO_DT_INPLACE", CS%dRcv_dT_inplace, & - "The value of drho_dT above which geothermal heating \n"//& - "simply heats water in place instead of moving it between \n"//& + "The value of drho_dT above which geothermal heating "//& + "simply heats water in place instead of moving it between "//& "isopycnal layers. This must be negative.", & units="kg m-3 K-1", default=-0.01) if (CS%dRcv_dT_inplace >= 0.0) call MOM_error(FATAL, "geothermal_init: "//& @@ -370,7 +370,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) filename = trim(inputdir)//trim(geo_file) call log_param(param_file, mdl, "INPUTDIR/GEOTHERMAL_FILE", filename) call get_param(param_file, mdl, "GEOTHERMAL_VARNAME", geotherm_var, & - "The name of the geothermal heating variable in \n"//& + "The name of the geothermal heating variable in "//& "GEOTHERMAL_FILE.", default="geo_heat") call MOM_read_data(filename, trim(geotherm_var), CS%geo_heat, G%Domain) do j=jsd,jed ; do i=isd,ied diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index f1276be827..bbc8250234 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -294,7 +294,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & - "Turn off internal tidal dissipation when the total \n"//& + "Turn off internal tidal dissipation when the total "//& "ocean depth is less than this value.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "UTIDE", utide, & @@ -308,7 +308,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed)) ; CS%TKE_itidal_coef(:,:) = 0.0 call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & - "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& + "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & units="m-1", default=8.e-4*atan(1.0)) @@ -316,16 +316,16 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & - "The maximum internal tide energy source available to mix \n"//& + "The maximum internal tide energy source available to mix "//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & units="W m-2", default=1.0e3) call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (read_tideamp) then call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) @@ -333,7 +333,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & - "The path to the file containing the sub-grid-scale \n"//& + "The path to the file containing the sub-grid-scale "//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 428048665b..b5caeb2f53 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -2021,86 +2021,86 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, & "Parameterization of shear-driven turbulence following Jackson, Hallberg and Legg, JPO 2008") call get_param(param_file, mdl, "USE_JACKSON_PARAM", kappa_shear_init, & - "If true, use the Jackson-Hallberg-Legg (JPO 2008) \n"//& + "If true, use the Jackson-Hallberg-Legg (JPO 2008) "//& "shear mixing parameterization.", default=.false.) call get_param(param_file, mdl, "VERTEX_SHEAR", CS%KS_at_vertex, & - "If true, do the calculations of the shear-driven mixing \n"//& + "If true, do the calculations of the shear-driven mixing "//& "at the cell vertices (i.e., the vorticity points).", & default=.false.) call get_param(param_file, mdl, "RINO_CRIT", CS%RiNo_crit, & "The critical Richardson number for shear mixing.", & units="nondim", default=0.25) call get_param(param_file, mdl, "SHEARMIX_RATE", CS%Shearmix_rate, & - "A nondimensional rate scale for shear-driven entrainment.\n"//& + "A nondimensional rate scale for shear-driven entrainment. "//& "Jackson et al find values in the range of 0.085-0.089.", & units="nondim", default=0.089) call get_param(param_file, mdl, "MAX_RINO_IT", CS%max_RiNo_it, & - "The maximum number of iterations that may be used to \n"//& + "The maximum number of iterations that may be used to "//& "estimate the Richardson number driven mixing.", & units="nondim", default=50) call get_param(param_file, mdl, "KD", KD_normal, default=1.0e-7, do_not_log=.true.) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & - "The background diffusivity that is used to smooth the \n"//& - "density and shear profiles before solving for the \n"//& + "The background diffusivity that is used to smooth the "//& + "density and shear profiles before solving for the "//& "diffusivities. Defaults to value of KD.", & units="m2 s-1", default=KD_normal, scale=US%m_to_Z**2) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & - "The nondimensional curvature of the function of the \n"//& - "Richardson number in the kappa source term in the \n"//& + "The nondimensional curvature of the function of the "//& + "Richardson number in the kappa source term in the "//& "Jackson et al. scheme.", units="nondim", default=-0.97) call get_param(param_file, mdl, "TKE_N_DECAY_CONST", CS%C_N, & - "The coefficient for the decay of TKE due to \n"//& - "stratification (i.e. proportional to N*tke). \n"//& + "The coefficient for the decay of TKE due to "//& + "stratification (i.e. proportional to N*tke). "//& "The values found by Jackson et al. are 0.24-0.28.", & units="nondim", default=0.24) ! call get_param(param_file, mdl, "LAYER_KAPPA_STAGGER", CS%layer_stagger, & ! default=.false.) call get_param(param_file, mdl, "TKE_SHEAR_DECAY_CONST", CS%C_S, & - "The coefficient for the decay of TKE due to shear (i.e. \n"//& - "proportional to |S|*tke). The values found by Jackson \n"//& + "The coefficient for the decay of TKE due to shear (i.e. "//& + "proportional to |S|*tke). The values found by Jackson "//& "et al. are 0.14-0.12.", units="nondim", default=0.14) call get_param(param_file, mdl, "KAPPA_BUOY_SCALE_COEF", CS%lambda, & - "The coefficient for the buoyancy length scale in the \n"//& - "kappa equation. The values found by Jackson et al. are \n"//& + "The coefficient for the buoyancy length scale in the "//& + "kappa equation. The values found by Jackson et al. are "//& "in the range of 0.81-0.86.", units="nondim", default=0.82) call get_param(param_file, mdl, "KAPPA_N_OVER_S_SCALE_COEF2", CS%lambda2_N_S, & - "The square of the ratio of the coefficients of the \n"//& - "buoyancy and shear scales in the diffusivity equation, \n"//& - "Set this to 0 (the default) to eliminate the shear scale. \n"//& + "The square of the ratio of the coefficients of the "//& + "buoyancy and shear scales in the diffusivity equation, "//& + "Set this to 0 (the default) to eliminate the shear scale. "//& "This is only used if USE_JACKSON_PARAM is true.", & units="nondim", default=0.0) call get_param(param_file, mdl, "KAPPA_SHEAR_TOL_ERR", CS%kappa_tol_err, & - "The fractional error in kappa that is tolerated. \n"//& - "Iteration stops when changes between subsequent \n"//& - "iterations are smaller than this everywhere in a \n"//& - "column. The peak diffusivities usually converge most \n"//& + "The fractional error in kappa that is tolerated. "//& + "Iteration stops when changes between subsequent "//& + "iterations are smaller than this everywhere in a "//& + "column. The peak diffusivities usually converge most "//& "rapidly, and have much smaller errors than this.", & units="nondim", default=0.1) call get_param(param_file, mdl, "TKE_BACKGROUND", CS%TKE_bg, & - "A background level of TKE used in the first iteration \n"//& + "A background level of TKE used in the first iteration "//& "of the kappa equation. TKE_BACKGROUND could be 0.", & units="m2 s-2", default=0.0) call get_param(param_file, mdl, "KAPPA_SHEAR_ELIM_MASSLESS", CS%eliminate_massless, & - "If true, massless layers are merged with neighboring \n"//& - "massive layers in this calculation. The default is \n"//& - "true and I can think of no good reason why it should \n"//& + "If true, massless layers are merged with neighboring "//& + "massive layers in this calculation. The default is "//& + "true and I can think of no good reason why it should "//& "be false. This is only used if USE_JACKSON_PARAM is true.", & default=.true.) call get_param(param_file, mdl, "MAX_KAPPA_SHEAR_IT", CS%max_KS_it, & - "The maximum number of iterations that may be used to \n"//& + "The maximum number of iterations that may be used to "//& "estimate the time-averaged diffusivity.", units="nondim", & default=13) call get_param(param_file, mdl, "PRANDTL_TURB", CS%Prandtl_turb, & - "The turbulent Prandtl number applied to shear \n"//& + "The turbulent Prandtl number applied to shear "//& "instability.", units="nondim", default=1.0, do_not_log=.true.) call get_param(param_file, mdl, "VEL_UNDERFLOW", CS%vel_underflow, & - "A negligibly small velocity magnitude below which velocity \n"//& - "components are set to 0. A reasonable value might be \n"//& - "1e-30 m/s, which is less than an Angstrom divided by \n"//& + "A negligibly small velocity magnitude below which velocity "//& + "components are set to 0. A reasonable value might be "//& + "1e-30 m/s, which is less than an Angstrom divided by "//& "the age of the universe.", units="m s-1", default=0.0) call get_param(param_file, mdl, "DEBUG_KAPPA_SHEAR", CS%debug, & "If true, write debugging data for the kappa-shear code. \n"//& - "Caution: this option is _very_ verbose and should only \n"//& + "Caution: this option is _very_ verbose and should only "//& "be used in single-column mode!", & default=.false., debuggingParam=.true.) @@ -2112,7 +2112,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%nkml = 1 if (GV%nkml>0) then call get_param(param_file, mdl, "KAPPA_SHEAR_MERGE_ML",merge_mixedlayer, & - "If true, combine the mixed layers together before \n"//& + "If true, combine the mixed layers together before "//& "solving the kappa-shear equations.", default=.true.) if (merge_mixedlayer) CS%nkml = GV%nkml endif @@ -2160,7 +2160,7 @@ logical function kappa_shear_at_vertex(param_file) kappa_shear_at_vertex = .false. if (do_Kappa_Shear) & call get_param(param_file, mdl, "VERTEX_SHEAR", kappa_shear_at_vertex, & - "If true, do the calculations of the shear-driven mixing \n"//& + "If true, do the calculations of the shear-driven mixing "//& "at the cell vertices (i.e., the vorticity points).", & default=.false., do_not_log=.true.) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index e89ded7e13..75aa447e15 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -477,15 +477,15 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) ! parameters for CHL_A routines call get_param(param_file, mdl, "VAR_PEN_SW", CS%var_pen_sw, & - "If true, use one of the CHL_A schemes specified by \n"//& - "OPACITY_SCHEME to determine the e-folding depth of \n"//& + "If true, use one of the CHL_A schemes specified by "//& + "OPACITY_SCHEME to determine the e-folding depth of "//& "incoming short wave radiation.", default=.false.) CS%opacity_scheme = NO_SCHEME ; scheme_string = '' if (CS%var_pen_sw) then call get_param(param_file, mdl, "OPACITY_SCHEME", tmpstr, & - "This character string specifies how chlorophyll \n"//& - "concentrations are translated into opacities. Currently \n"//& + "This character string specifies how chlorophyll "//& + "concentrations are translated into opacities. Currently "//& "valid options include:\n"//& " \t\t MANIZZA_05 - Use Manizza et al., GRL, 2005. \n"//& " \t\t MOREL_88 - Use Morel, JGR, 1988.", & @@ -516,8 +516,8 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") call get_param(param_file, mdl, "CHL_FILE", chl_file, & - "CHL_FILE is the file containing chl_a concentrations in \n"//& - "the variable CHL_A. It is used when VAR_PEN_SW and \n"//& + "CHL_FILE is the file containing chl_a concentrations in "//& + "the variable CHL_A. It is used when VAR_PEN_SW and "//& "CHL_FROM_FILE are true.", fail_if_missing=.true.) filename = trim(slasher(inputdir))//trim(chl_file) call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", filename) @@ -527,12 +527,12 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) endif call get_param(param_file, mdl, "BLUE_FRAC_SW", CS%blue_frac, & - "The fraction of the penetrating shortwave radiation \n"//& + "The fraction of the penetrating shortwave radiation "//& "that is in the blue band.", default=0.5, units="nondim") else call get_param(param_file, mdl, "EXP_OPACITY_SCHEME", tmpstr, & - "This character string specifies which exponential \n"//& - "opacity scheme to utilize. Currently \n"//& + "This character string specifies which exponential "//& + "opacity scheme to utilize. Currently "//& "valid options include:\n"//& " \t\t SINGLE_EXP - Single Exponent decay. \n"//& " \t\t DOUBLE_EXP - Double Exponent decay.", & @@ -548,17 +548,17 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, 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 \n"//& + "The vertical absorption e-folding depth of the "//& "penetrating shortwave radiation.", units="m", default=0.0) !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 \n"//& - "penetrating shortwave radiation \n"//& + "The (2nd) vertical absorption e-folding depth of the "//& + "penetrating shortwave radiation "//& "(use if SW_EXP_MODE==double.)",& units="m", default=0.0) call get_param(param_file, mdl, "SW_1ST_EXP_RATIO", CS%sw_1st_exp_ratio, & - "The fraction of 1st vertical absorption e-folding depth \n"//& + "The fraction of 1st vertical absorption e-folding depth "//& "penetrating shortwave radiation if SW_EXP_MODE==double.",& units="m", default=0.0) elseif (CS%OPACITY_SCHEME == Single_Exp) then @@ -567,7 +567,7 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%sw_1st_exp_ratio = 1.0 endif call get_param(param_file, mdl, "PEN_SW_FRAC", CS%pen_sw_frac, & - "The fraction of the shortwave radiation that penetrates \n"//& + "The fraction of the shortwave radiation that penetrates "//& "below the surface.", units="nondim", default=0.0) endif @@ -606,7 +606,7 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) endif call get_param(param_file, mdl, "OPACITY_LAND_VALUE", CS%opacity_land_value, & - "The value to use for opacity over land. The default is \n"//& + "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)) & diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 989b2f0154..cca2d9f94e 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -899,23 +899,23 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "REGULARIZE_SURFACE_LAYERS", CS%regularize_surface_layers, & - "If defined, vertically restructure the near-surface \n"//& - "layers when they have too much lateral variations to \n"//& + "If defined, vertically restructure the near-surface "//& + "layers when they have too much lateral variations to "//& "allow for sensible lateral barotropic transports.", & default=.false.) if (CS%regularize_surface_layers) then call get_param(param_file, mdl, "REGULARIZE_SURFACE_DETRAIN", CS%reg_sfc_detrain, & - "If true, allow the buffer layers to detrain into the \n"//& - "interior as a part of the restructuring when \n"//& + "If true, allow the buffer layers to detrain into the "//& + "interior as a part of the restructuring when "//& "REGULARIZE_SURFACE_LAYERS is true.", default=.true.) endif call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & - "The minimum mixed layer depth if the mixed layer depth \n"//& + "The minimum mixed layer depth if the mixed layer depth "//& "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H) call get_param(param_file, mdl, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, & - "The value of the relative thickness deficit at which \n"//& - "to start modifying the layer structure when \n"//& + "The value of the relative thickness deficit at which "//& + "to start modifying the layer structure when "//& "REGULARIZE_SURFACE_LAYERS is true.", units="nondim", & default=0.5) CS%h_def_tol2 = 0.2 + 0.8*CS%h_def_tol1 @@ -927,9 +927,8 @@ 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.) - 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 \n"//& + 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.) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c5fe83a9e7..d450ca37ab 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1958,54 +1958,54 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "FLUX_RI_MAX", CS%FluxRi_max, & - "The flux Richardson number where the stratification is \n"//& - "large enough that N2 > omega2. The full expression for \n"//& - "the Flux Richardson number is usually \n"//& + "The flux Richardson number where the stratification is "//& + "large enough that N2 > omega2. The full expression for "//& + "the Flux Richardson number is usually "//& "FLUX_RI_MAX*N2/(N2+OMEGA2).", default=0.2) call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5, scale=US%T_to_s) call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & - "If true, allow a fraction of TKE available from wind \n"//& - "work to penetrate below the base of the mixed layer \n"//& - "with a vertical decay scale determined by the minimum \n"//& - "of: (1) The depth of the mixed layer, (2) an Ekman \n"//& + "If true, allow a fraction of TKE available from wind "//& + "work to penetrate below the base of the mixed layer "//& + "with a vertical decay scale determined by the minimum "//& + "of: (1) The depth of the mixed layer, (2) an Ekman "//& "length scale.", default=.false.) if (CS%ML_radiation) then ! This give a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + GV%H_subroundoff*GV%H_to_Z) call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, & - "A coefficient that is used to scale the penetration \n"//& - "depth for turbulence below the base of the mixed layer. \n"//& + "A coefficient that is used to scale the penetration "//& + "depth for turbulence below the base of the mixed layer. "//& "This is only used if ML_RADIATION is true.", units="nondim", & default=0.2) call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & - "The maximum diapycnal diffusivity due to turbulence \n"//& - "radiated from the base of the mixed layer. \n"//& + "The maximum diapycnal diffusivity due to turbulence "//& + "radiated from the base of the mixed layer. "//& "This is only used if ML_RADIATION is true.", & units="m2 s-1", default=1.0e-3, & scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & - "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& - "the energy available for mixing below the base of the \n"//& + "The coefficient which scales MSTAR*USTAR^3 to obtain "//& + "the energy available for mixing below the base of the "//& "mixed layer. This is only used if ML_RADIATION is true.", & units="nondim", default=0.2) call get_param(param_file, mdl, "ML_RAD_APPLY_TKE_DECAY", CS%ML_rad_TKE_decay, & - "If true, apply the same exponential decay to ML_rad as \n"//& - "is applied to the other surface sources of TKE in the \n"//& + "If true, apply the same exponential decay to ML_rad as "//& + "is applied to the other surface sources of TKE in the "//& "mixed layer code. This is only used if ML_RADIATION is true.", & default=.true.) call get_param(param_file, mdl, "MSTAR", CS%mstar, & - "The ratio of the friction velocity cubed to the TKE \n"//& + "The ratio of the friction velocity cubed to the TKE "//& "input to the mixed layer.", "units=nondim", default=1.2) call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & "The ratio of the natural Ekman depth to the TKE decay scale.", & units="nondim", default=2.5) call get_param(param_file, mdl, "ML_USE_OMEGA", ML_use_omega, & - "If true, use the absolute rotation rate instead of the \n"//& - "vertical component of rotation when setting the decay \n"//& + "If true, use the absolute rotation rate instead of the "//& + "vertical component of rotation when setting the decay "//& "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (ML_use_omega) then @@ -2013,48 +2013,48 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z omega_frac_dflt = 1.0 endif call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%ML_omega_frac, & - "When setting the decay scale for turbulence, use this \n"//& - "fraction of the absolute rotation rate blended with the \n"//& + "When setting the decay scale for turbulence, use this "//& + "fraction of the absolute rotation rate blended with the "//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) endif call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & - "If true, the bottom stress is calculated with a drag \n"//& - "law of the form c_drag*|u|*u. The velocity magnitude \n"//& - "may be an assumed value or it may be based on the \n"//& - "actual velocity in the bottommost HBBL, depending on \n"//& + "If true, the bottom stress is calculated with a drag "//& + "law of the form c_drag*|u|*u. The velocity magnitude "//& + "may be an assumed value or it may be based on the "//& + "actual velocity in the bottommost HBBL, depending on "//& "LINEAR_DRAG.", default=.true.) if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & - "The drag coefficient relating the magnitude of the \n"//& - "velocity field to the bottom stress. CDRAG is only used \n"//& + "The drag coefficient relating the magnitude of the "//& + "velocity field to the bottom stress. CDRAG is only used "//& "if BOTTOMDRAGLAW is true.", units="nondim", default=0.003) call get_param(param_file, mdl, "BBL_EFFIC", CS%BBL_effic, & - "The efficiency with which the energy extracted by \n"//& - "bottom drag drives BBL diffusion. This is only \n"//& + "The efficiency with which the energy extracted by "//& + "bottom drag drives BBL diffusion. This is only "//& "used if BOTTOMDRAGLAW is true.", units="nondim", default=0.20) call get_param(param_file, mdl, "BBL_MIXING_MAX_DECAY", decay_length, & - "The maximum decay scale for the BBL diffusion, or 0 \n"//& - "to allow the mixing to penetrate as far as \n"//& - "stratification and rotation permit. The default is 0. \n"//& + "The maximum decay scale for the BBL diffusion, or 0 "//& + "to allow the mixing to penetrate as far as "//& + "stratification and rotation permit. The default is 0. "//& "This is only used if BOTTOMDRAGLAW is true.", & units="m", default=0.0, scale=US%m_to_Z) CS%IMax_decay = 1.0 / (200.0*US%m_to_Z) !### This is inconsistent with the description above. if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & - "If true, take the maximum of the diffusivity from the \n"//& - "BBL mixing and the other diffusivities. Otherwise, \n"//& + "If true, take the maximum of the diffusivity from the "//& + "BBL mixing and the other diffusivities. Otherwise, "//& "diffusivity from the BBL_mixing is simply added.", & default=.true.) call get_param(param_file, mdl, "USE_LOTW_BBL_DIFFUSIVITY", CS%use_LOTW_BBL_diffusivity, & - "If true, uses a simple, imprecise but non-coordinate dependent, model\n"//& - "of BBL mixing diffusivity based on Law of the Wall. Otherwise, uses\n"//& + "If true, uses a simple, imprecise but non-coordinate dependent, model "//& + "of BBL mixing diffusivity based on Law of the Wall. Otherwise, uses "//& "the original BBL scheme.", default=.false.) if (CS%use_LOTW_BBL_diffusivity) then call get_param(param_file, mdl, "LOTW_BBL_USE_OMEGA", CS%LOTW_BBL_use_omega, & - "If true, use the maximum of Omega and N for the TKE to diffusion\n"//& + "If true, use the maximum of Omega and N for the TKE to diffusion "//& "calculation. Otherwise, N is N.", default=.true.) endif else @@ -2064,9 +2064,9 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z 'Bottom Boundary Layer Diffusivity', 'm2 s-1', & conversion=US%Z2_T_to_m2_s) 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\n"//& - "work for arbitrary vertical coordinates. If false,\n"//& - "calculates Kd/TKE and bounds based on exact energetics\n"//& + "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.) @@ -2074,14 +2074,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp) call get_param(param_file, mdl, "KV", CS%Kv, & - "The background kinematic viscosity in the interior. \n"//& + "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", scale=US%m2_s_to_Z2_T, & fail_if_missing=.true.) call get_param(param_file, mdl, "KD", CS%Kd, & - "The background diapycnal diffusivity of density in the \n"//& - "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& + "The background diapycnal diffusivity of density in the "//& + "interior. Zero or the molecular value, ~1e-7 m2 s-1, "//& "may be used.", units="m2 s-1", scale=US%m2_s_to_Z2_T, & fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & @@ -2089,14 +2089,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, & scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & - "The maximum permitted increment for the diapycnal \n"//& - "diffusivity from TKE-based parameterizations, or a \n"//& + "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, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & - "A uniform diapycnal diffusivity that is added \n"//& + "A uniform diapycnal diffusivity that is added "//& "everywhere without any filtering or scaling.", & units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & @@ -2114,14 +2114,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z else ! ### This parameter is unused and is staged for deletion call get_param(param_file, mdl, "KDML", CS%Kdml, & - "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& - "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& + "If BULKMIXEDLAYER is false, KDML is the elevated "//& + "diapycnal diffusivity in the topmost HMIX of fluid. "//& "KDML is only used if BULKMIXEDLAYER is false.", & units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, & scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & - "The prescribed depth over which the near-surface \n"//& - "viscosity and diffusivity are elevated when the bulk \n"//& + "The prescribed depth over which the near-surface "//& + "viscosity and diffusivity are elevated when the bulk "//& "mixed layer is not used.", units="m", fail_if_missing=.true.) endif call get_param(param_file, mdl, "DEBUG", CS%debug, & @@ -2133,18 +2133,18 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z default=.false.) call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & - "The minimum dissipation by which to determine a lower \n"//& + "The minimum dissipation by which to determine a lower "//& "bound of Kd (a floor).", units="W m-3", default=0.0, & scale=US%m2_s_to_Z2_T*(US%T_to_s**2)) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & - "The intercept when N=0 of the N-dependent expression \n"//& - "used to set a minimum dissipation by which to determine \n"//& + "The intercept when N=0 of the N-dependent expression "//& + "used to set a minimum dissipation by which to determine "//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & units="W m-3", default=0.0, & scale=US%m2_s_to_Z2_T*(US%T_to_s**2)) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & - "The coefficient multiplying N, following Gargett, used to \n"//& - "set a minimum dissipation by which to determine a lower \n"//& + "The coefficient multiplying N, following Gargett, used to "//& + "set a minimum dissipation by which to determine a lower "//& "bound of Kd (a floor): B in eps_min = A + B*N", & units="J m-3", default=0.0, scale=US%m2_s_to_Z2_T*US%T_to_s) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & @@ -2192,7 +2192,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z endif call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & - "If true, increase diffusivites for temperature or salt \n"//& + "If true, increase diffusivites for temperature or salt "//& "based on double-diffusive parameterization from MOM4/KPP.", & default=.false.) @@ -2204,7 +2204,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "Maximum salt diffusivity for salt fingering regime.", & default=1.e-4, units="m2 s-1", scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & - "Molecular viscosity for calculation of fluxes under \n"//& + "Molecular viscosity for calculation of fluxes under "//& "double-diffusive convection.", default=1.5e-6, units="m2 s-1", & scale=US%m2_s_to_Z2_T) ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index b4c4abb870..1265067ef2 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1700,12 +1700,12 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) use_CVMix_shear = CVMix_shear_is_used(param_file) use_CVMix_conv = CVMix_conv_is_used(param_file) call get_param(param_file, mdl, "USE_KPP", useKPP, & - "If true, turns on the [CVMix] KPP scheme of Large et al., 1984,\n"// & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "//& "to calculate diffusivities and non-local transport in the OBL.", & default=.false., do_not_log=.true.) call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, & - "If true, use an implied energetics planetary boundary \n"//& - "layer scheme to determine the diffusivity and viscosity \n"//& + "If true, use an implied energetics planetary boundary "//& + "layer scheme to determine the diffusivity and viscosity "//& "in the surface boundary layer.", default=.false., do_not_log=.true.) endif @@ -1812,65 +1812,65 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. differential_diffusion = .false. call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & - "If true, the bottom stress is calculated with a drag \n"//& - "law of the form c_drag*|u|*u. The velocity magnitude \n"//& - "may be an assumed value or it may be based on the \n"//& - "actual velocity in the bottommost HBBL, depending on \n"//& + "If true, the bottom stress is calculated with a drag "//& + "law of the form c_drag*|u|*u. The velocity magnitude "//& + "may be an assumed value or it may be based on the "//& + "actual velocity in the bottommost HBBL, depending on "//& "LINEAR_DRAG.", default=.true.) call get_param(param_file, mdl, "CHANNEL_DRAG", CS%Channel_drag, & - "If true, the bottom drag is exerted directly on each \n"//& - "layer proportional to the fraction of the bottom it \n"//& + "If true, the bottom drag is exerted directly on each "//& + "layer proportional to the fraction of the bottom it "//& "overlies.", default=.false.) call get_param(param_file, mdl, "LINEAR_DRAG", CS%linear_drag, & - "If LINEAR_DRAG and BOTTOMDRAGLAW are defined the drag \n"//& + "If LINEAR_DRAG and BOTTOMDRAGLAW are defined the drag "//& "law is cdrag*DRAG_BG_VEL*u.", default=.false.) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) if (adiabatic) then call log_param(param_file, mdl, "ADIABATIC",adiabatic, & - "There are no diapycnal mass fluxes if ADIABATIC is \n"//& - "true. This assumes that KD = KDML = 0.0 and that \n"//& - "there is no buoyancy forcing, but makes the model \n"//& + "There are no diapycnal mass fluxes if ADIABATIC is "//& + "true. This assumes that KD = KDML = 0.0 and that "//& + "there is no buoyancy forcing, but makes the model "//& "faster by eliminating subroutine calls.", default=.false.) endif if (.not.adiabatic) then CS%RiNo_mix = kappa_shear_is_used(param_file) call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & - "If true, increase diffusivites for temperature or salt \n"//& + "If true, increase diffusivites for temperature or salt "//& "based on double-diffusive parameterization from MOM4/KPP.", & default=.false.) use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) endif call get_param(param_file, mdl, "PRANDTL_TURB", visc%Prandtl_turb, & - "The turbulent Prandtl number applied to shear \n"//& + "The turbulent Prandtl number applied to shear "//& "instability.", units="nondim", default=1.0) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) call get_param(param_file, mdl, "DYNAMIC_VISCOUS_ML", CS%dynamic_viscous_ML, & - "If true, use a bulk Richardson number criterion to \n"//& + "If true, use a bulk Richardson number criterion to "//& "determine the mixed layer thickness for viscosity.", & default=.false.) if (CS%dynamic_viscous_ML) then call get_param(param_file, mdl, "BULK_RI_ML", bulk_Ri_ML_dflt, default=0.0) call get_param(param_file, mdl, "BULK_RI_ML_VISC", CS%bulk_Ri_ML, & - "The efficiency with which mean kinetic energy released \n"//& - "by mechanically forced entrainment of the mixed layer \n"//& - "is converted to turbulent kinetic energy. By default, \n"//& + "The efficiency with which mean kinetic energy released "//& + "by mechanically forced entrainment of the mixed layer "//& + "is converted to turbulent kinetic energy. By default, "//& "BULK_RI_ML_VISC = BULK_RI_ML or 0.", units="nondim", & default=bulk_Ri_ML_dflt) call get_param(param_file, mdl, "TKE_DECAY", TKE_decay_dflt, default=0.0) call get_param(param_file, mdl, "TKE_DECAY_VISC", CS%TKE_decay, & - "TKE_DECAY_VISC relates the vertical rate of decay of \n"//& - "the TKE available for mechanical entrainment to the \n"//& - "natural Ekman depth for use in calculating the dynamic \n"//& - "mixed layer viscosity. By default, \n"//& + "TKE_DECAY_VISC relates the vertical rate of decay of "//& + "the TKE available for mechanical entrainment to the "//& + "natural Ekman depth for use in calculating the dynamic "//& + "mixed layer viscosity. By default, "//& "TKE_DECAY_VISC = TKE_DECAY or 0.", units="nondim", & default=TKE_decay_dflt) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & - "If true, use the absolute rotation rate instead of the \n"//& - "vertical component of rotation when setting the decay \n"//& + "If true, use the absolute rotation rate instead of the "//& + "vertical component of rotation when setting the decay "//& "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then @@ -1878,8 +1878,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS omega_frac_dflt = 1.0 endif call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & - "When setting the decay scale for turbulence, use this \n"//& - "fraction of the absolute rotation rate blended with the \n"//& + "When setting the decay scale for turbulence, use this "//& + "fraction of the absolute rotation rate blended with the "//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "OMEGA", CS%omega, & @@ -1894,62 +1894,62 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & - "The thickness of a bottom boundary layer with a \n"//& - "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& - "the thickness over which near-bottom velocities are \n"//& - "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& + "The thickness of a bottom boundary layer with a "//& + "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or "//& + "the thickness over which near-bottom velocities are "//& + "averaged for the drag law if BOTTOMDRAGLAW is defined "//& "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) ! Rescaled later if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & - "CDRAG is the drag coefficient relating the magnitude of \n"//& - "the velocity field to the bottom stress. CDRAG is only \n"//& + "CDRAG is the drag coefficient relating the magnitude of "//& + "the velocity field to the bottom stress. CDRAG is only "//& "used if BOTTOMDRAGLAW is defined.", units="nondim", & default=0.003) call get_param(param_file, mdl, "DRAG_BG_VEL", CS%drag_bg_vel, & - "DRAG_BG_VEL is either the assumed bottom velocity (with \n"//& - "LINEAR_DRAG) or an unresolved velocity that is \n"//& - "combined with the resolved velocity to estimate the \n"//& - "velocity magnitude. DRAG_BG_VEL is only used when \n"//& + "DRAG_BG_VEL is either the assumed bottom velocity (with "//& + "LINEAR_DRAG) or an unresolved velocity that is "//& + "combined with the resolved velocity to estimate the "//& + "velocity magnitude. DRAG_BG_VEL is only used when "//& "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0) call get_param(param_file, mdl, "BBL_USE_EOS", CS%BBL_use_EOS, & - "If true, use the equation of state in determining the \n"//& - "properties of the bottom boundary layer. Otherwise use \n"//& + "If true, use the equation of state in determining the "//& + "properties of the bottom boundary layer. Otherwise use "//& "the layer target potential densities.", default=.false.) endif call get_param(param_file, mdl, "BBL_THICK_MIN", CS%BBL_thick_min, & - "The minimum bottom boundary layer thickness that can be \n"//& - "used with BOTTOMDRAGLAW. This might be \n"//& - "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& + "The minimum bottom boundary layer thickness that can be "//& + "used with BOTTOMDRAGLAW. This might be "//& + "Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//& "near-bottom viscosity.", units="m", default=0.0) ! Rescaled later call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & - "The minimum top boundary layer thickness that can be \n"//& - "used with BOTTOMDRAGLAW. This might be \n"//& - "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& + "The minimum top boundary layer thickness that can be "//& + "used with BOTTOMDRAGLAW. This might be "//& + "Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//& "near-top viscosity.", units="m", default=CS%BBL_thick_min, scale=GV%m_to_H) call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, & - "The thickness over which near-surface velocities are \n"//& - "averaged for the drag law under an ice shelf. By \n"//& + "The thickness over which near-surface velocities are "//& + "averaged for the drag law under an ice shelf. By "//& "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H) ! These unit conversions are out outside the get_param calls because the are also defaults. CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale call get_param(param_file, mdl, "KV", Kv_background, & - "The background kinematic viscosity in the interior. \n"//& + "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) call get_param(param_file, mdl, "ADD_KV_SLOW", visc%add_Kv_slow, & - "If true, the background vertical viscosity in the interior \n"//& - "(i.e., tidal + background + shear + convection) is added \n"// & - "when computing the coupling coefficient. The purpose of this \n"// & - "flag is to be able to recover previous answers and it will likely \n"// & + "If true, the background vertical viscosity in the interior "//& + "(i.e., tidal + background + shear + convection) is added "//& + "when computing the coupling coefficient. The purpose of this "//& + "flag is to be able to recover previous answers and it will likely "//& "be removed in the future since this option should always be true.", & default=.false.) call get_param(param_file, mdl, "USE_KPP", use_KPP, & - "If true, turns on the [CVMix] KPP scheme of Large et al., 1994,\n"// & - "to calculate diffusivities and non-local transport in the OBL.", & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "//& + "to calculate diffusivities and non-local transport in the OBL.", & do_not_log=.true., default=.false.) if (use_KPP .and. visc%add_Kv_slow) call MOM_error(FATAL,"set_visc_init: "//& @@ -1971,10 +1971,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (smag_const1 >= 0.0) cSmag_chan_dflt = smag_const1 call get_param(param_file, mdl, "SMAG_CONST_CHANNEL", CS%c_Smag, & - "The nondimensional Laplacian Smagorinsky constant used \n"//& - "in calculating the channel drag if it is enabled. The \n"//& - "default is to use the same value as SMAG_LAP_CONST if \n"//& - "it is defined, or 0.15 if it is not. The value used is \n"//& + "The nondimensional Laplacian Smagorinsky constant used "//& + "in calculating the channel drag if it is enabled. The "//& + "default is to use the same value as SMAG_LAP_CONST if "//& + "it is defined, or 0.15 if it is not. The value used is "//& "also 0.15 if the specified value is negative.", & units="nondim", default=cSmag_chan_dflt) if (CS%c_Smag < 0.0) CS%c_Smag = 0.15 diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index af151cbf38..978e8d1807 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -118,8 +118,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & ! Set default, read and log parameters call log_version(param_file, mdl, version) call get_param(param_file, mdl, "SPONGE", use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) if (.not.use_sponge) return diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b82313dc6c..39bec8cccb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -261,8 +261,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".",do_not_log=.true.) CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%int_tide_dissipation, & - "If true, use an internal tidal dissipation scheme to \n"//& - "drive diapycnal mixing, along the lines of St. Laurent \n"//& + "If true, use an internal tidal dissipation scheme to "//& + "drive diapycnal mixing, along the lines of St. Laurent "//& "et al. (2002) and Simmons et al. (2004).", default=CS%use_CVMix_tidal) ! return if tidal mixing is inactive @@ -274,7 +274,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ ! Read in CVMix tidal scheme if CVMix tidal mixing is on if (CS%use_CVMix_tidal) then call get_param(param_file, mdl, "CVMIX_TIDAL_SCHEME", CVMix_tidal_scheme_str, & - "CVMIX_TIDAL_SCHEME selects the CVMix tidal mixing\n"//& + "CVMIX_TIDAL_SCHEME selects the CVMix tidal mixing "//& "scheme with INT_TIDE_DISSIPATION. Valid values are:\n"//& "\t SIMMONS - Use the Simmons et al (2004) tidal \n"//& "\t mixing scheme.\n"//& @@ -295,7 +295,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ ! Read in vertical profile of tidal energy dissipation if ( CS%CVMix_tidal_scheme.eq.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 \n"//& + "INT_TIDE_PROFILE selects the vertical profile of energy "//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& "\t decay profile.\n"//& @@ -319,9 +319,9 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ endif call get_param(param_file, mdl, "LEE_WAVE_DISSIPATION", CS%Lee_wave_dissipation, & - "If true, use an lee wave driven dissipation scheme to \n"//& - "drive diapycnal mixing, along the lines of Nikurashin \n"//& - "(2010) and using the St. Laurent et al. (2002) \n"//& + "If true, use an lee wave driven dissipation scheme to "//& + "drive diapycnal mixing, along the lines of Nikurashin "//& + "(2010) and using the St. Laurent et al. (2002) "//& "and Simmons et al. (2004) vertical profile", default=.false.) if (CS%lee_wave_dissipation) then if (CS%use_CVMix_tidal) then @@ -329,7 +329,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ "be used when CVMix tidal mixing scheme is active.") endif call get_param(param_file, mdl, "LEE_WAVE_PROFILE", tmpstr, & - "LEE_WAVE_PROFILE selects the vertical profile of energy \n"//& + "LEE_WAVE_PROFILE selects the vertical profile of energy "//& "dissipation with LEE_WAVE_DISSIPATION. Valid values are:\n"//& "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& "\t decay profile.\n"//& @@ -347,10 +347,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ endif call get_param(param_file, mdl, "INT_TIDE_LOWMODE_DISSIPATION", CS%Lowmode_itidal_dissipation, & - "If true, consider mixing due to breaking low modes that \n"//& - "have been remotely generated; as with itidal drag on the \n"//& - "barotropic tide, use an internal tidal dissipation scheme to \n"//& - "drive diapycnal mixing, along the lines of St. Laurent \n"//& + "If true, consider mixing due to breaking low modes that "//& + "have been remotely generated; as with itidal drag on the "//& + "barotropic tide, use an internal tidal dissipation scheme to "//& + "drive diapycnal mixing, along the lines of St. Laurent "//& "et al. (2002) and Simmons et al. (2004).", default=.false.) if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & @@ -360,29 +360,29 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ "be used when CVMix tidal mixing scheme is active.") endif call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & - "When the Polzin decay profile is used, this is a \n"//& - "non-dimensional constant in the expression for the \n"//& + "When the Polzin decay profile is used, this is a "//& + "non-dimensional constant in the expression for the "//& "vertical scale of decay for the tidal energy dissipation.", & units="nondim", default=0.0697) call get_param(param_file, mdl, "NBOTREF_POLZIN", CS%Nbotref_Polzin, & - "When the Polzin decay profile is used, this is the \n"//& - "reference value of the buoyancy frequency at the ocean \n"//& - "bottom in the Polzin formulation for the vertical \n"//& + "When the Polzin decay profile is used, this is the "//& + "reference value of the buoyancy frequency at the ocean "//& + "bottom in the Polzin formulation for the vertical "//& "scale of decay for the tidal energy dissipation.", & units="s-1", default=9.61e-4) call get_param(param_file, mdl, "POLZIN_DECAY_SCALE_FACTOR", & CS%Polzin_decay_scale_factor, & - "When the Polzin decay profile is used, this is a \n"//& - "scale factor for the vertical scale of decay of the tidal \n"//& + "When the Polzin decay profile is used, this is a "//& + "scale factor for the vertical scale of decay of the tidal "//& "energy dissipation.", default=1.0, units="nondim") call get_param(param_file, mdl, "POLZIN_SCALE_MAX_FACTOR", & CS%Polzin_decay_scale_max_factor, & - "When the Polzin decay profile is used, this is a factor \n"//& - "to limit the vertical scale of decay of the tidal \n"//& - "energy dissipation to POLZIN_DECAY_SCALE_MAX_FACTOR \n"//& + "When the Polzin decay profile is used, this is a factor "//& + "to limit the vertical scale of decay of the tidal "//& + "energy dissipation to POLZIN_DECAY_SCALE_MAX_FACTOR "//& "times the depth of the ocean.", units="nondim", default=1.0) call get_param(param_file, mdl, "POLZIN_MIN_DECAY_SCALE", CS%Polzin_min_decay_scale, & - "When the Polzin decay profile is used, this is the \n"//& + "When the Polzin decay profile is used, this is the "//& "minimum vertical decay scale for the vertical profile\n"//& "of internal tide dissipation with the Polzin (2009) formulation", & units="m", default=0.0, scale=US%m_to_Z) @@ -390,20 +390,20 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then call get_param(param_file, mdl, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & - "The decay scale away from the bottom for tidal TKE with \n"//& + "The decay scale away from the bottom for tidal TKE with "//& "the new coding when INT_TIDE_DISSIPATION is used.", & !units="m", default=0.0) units="m", default=500.0, scale=US%m_to_Z) ! TODO: confirm this new default call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & - "A dimensionless turbulent mixing efficiency used with \n"//& + "A dimensionless turbulent mixing efficiency used with "//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) call get_param(param_file, mdl, "GAMMA_ITIDES", CS%Gamma_itides, & - "The fraction of the internal tidal energy that is \n"//& - "dissipated locally with INT_TIDE_DISSIPATION. \n"//& + "The fraction of the internal tidal energy that is "//& + "dissipated locally with INT_TIDE_DISSIPATION. "//& "THIS NAME COULD BE BETTER.", & units="nondim", default=0.3333) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & - "Turn off internal tidal dissipation when the total \n"//& + "Turn off internal tidal dissipation when the total "//& "ocean depth is less than this value.", units="m", default=0.0, scale=US%m_to_Z) endif @@ -416,7 +416,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call safe_alloc_ptr(CS%mask_itidal,isd,ied,jsd,jed) ; CS%mask_itidal(:,:) = 1.0 call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & - "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& + "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & units="m-1", default=8.e-4*atan(1.0), scale=US%Z_to_m) @@ -426,15 +426,15 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & - "A scaling factor for the roughness amplitude with \n"//& + "A scaling factor for the roughness amplitude with "//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & - "The maximum internal tide energy source available to mix \n"//& + "The maximum internal tide energy source available to mix "//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & units="W m-2", default=1.0e3, scale=US%m_to_Z**3*US%T_to_s**3) call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (read_tideamp) then if (CS%use_CVMix_tidal) then @@ -442,7 +442,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ "not compatible with CVMix tidal mixing. ") endif call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) @@ -450,7 +450,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ endif call get_param(param_file, mdl, "H2_FILE", h2_file, & - "The path to the file containing the sub-grid-scale \n"//& + "The path to the file containing the sub-grid-scale "//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) @@ -477,11 +477,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ if (CS%Lee_wave_dissipation) then call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE",Niku_TKE_input_file, & - "The path to the file containing the TKE input from lee \n"//& + "The path to the file containing the TKE input from lee "//& "wave driven mixing. Used with LEE_WAVE_DISSIPATION.", & fail_if_missing=.true.) call get_param(param_file, mdl, "NIKURASHIN_SCALE",Niku_scale, & - "A non-dimensional factor by which to scale the lee-wave \n"//& + "A non-dimensional factor by which to scale the lee-wave "//& "driven TKE input. Used with LEE_WAVE_DISSIPATION.", & units="nondim", default=1.0) @@ -494,11 +494,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & - "The fraction of the lee wave energy that is dissipated \n"//& + "The fraction of the lee wave energy that is dissipated "//& "locally with LEE_WAVE_DISSIPATION.", units="nondim", & default=0.3333) call get_param(param_file, mdl, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & - "Scaling for the vertical decay scaleof the local \n"//& + "Scaling for the vertical decay scaleof the local "//& "dissipation of lee waves dissipation.", units="nondim", & default=1.0) else @@ -514,17 +514,17 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ "largest acceptable value for tidal diffusivity", & units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMix, 100e-4 in POP. call get_param(param_file, mdl, "TIDAL_DISS_LIM_TC", CS%tidal_diss_lim_tc, & - "Min allowable depth for dissipation for tidal-energy-constituent data. \n"//& + "Min allowable depth for dissipation for tidal-energy-constituent data. "//& "No dissipation contribution is applied above TIDAL_DISS_LIM_TC.", & units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & - "The path to the file containing tidal energy \n"//& + "The path to the file containing tidal energy "//& "dissipation. Used with CVMix tidal mixing schemes.", & fail_if_missing=.true.) call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TIDAL", prandtl_tidal, & - "Prandtl number used by CVMix tidal mixing schemes \n"//& + "Prandtl number used by CVMix tidal mixing schemes "//& "to convert vertical diffusivities into viscosities.", & units="nondim", default=1.0, & do_not_log=.true.) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4d32974bfa..645daa1c4f 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1603,110 +1603,110 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! Default, read and log parameters call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & - "If true, the bottom stress is calculated with a drag \n"//& - "law of the form c_drag*|u|*u. The velocity magnitude \n"//& - "may be an assumed value or it may be based on the \n"//& - "actual velocity in the bottommost HBBL, depending on \n"//& + "If true, the bottom stress is calculated with a drag "//& + "law of the form c_drag*|u|*u. The velocity magnitude "//& + "may be an assumed value or it may be based on the "//& + "actual velocity in the bottommost HBBL, depending on "//& "LINEAR_DRAG.", default=.true.) call get_param(param_file, mdl, "CHANNEL_DRAG", CS%Channel_drag, & - "If true, the bottom drag is exerted directly on each \n"//& - "layer proportional to the fraction of the bottom it \n"//& + "If true, the bottom drag is exerted directly on each "//& + "layer proportional to the fraction of the bottom it "//& "overlies.", default=.false.) call get_param(param_file, mdl, "DIRECT_STRESS", CS%direct_stress, & - "If true, the wind stress is distributed over the \n"//& - "topmost HMIX_STRESS of fluid (like in HYCOM), and KVML \n"//& + "If true, the wind stress is distributed over the "//& + "topmost HMIX_STRESS of fluid (like in HYCOM), and KVML "//& "may be set to a very small value.", default=.false.) call get_param(param_file, mdl, "DYNAMIC_VISCOUS_ML", CS%dynamic_viscous_ML, & - "If true, use a bulk Richardson number criterion to \n"//& + "If true, use a bulk Richardson number criterion to "//& "determine the mixed layer thickness for viscosity.", & default=.false.) call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & - "The absolute path to a file into which the accelerations \n"//& - "leading to zonal velocity truncations are written. \n"//& - "Undefine this for efficiency if this diagnostic is not \n"//& + "The absolute path to a file into which the accelerations "//& + "leading to zonal velocity truncations are written. "//& + "Undefine this for efficiency if this diagnostic is not "//& "needed.", default=" ", debuggingParam=.true.) call get_param(param_file, mdl, "V_TRUNC_FILE", CS%v_trunc_file, & - "The absolute path to a file into which the accelerations \n"//& - "leading to meridional velocity truncations are written. \n"//& - "Undefine this for efficiency if this diagnostic is not \n"//& + "The absolute path to a file into which the accelerations "//& + "leading to meridional velocity truncations are written. "//& + "Undefine this for efficiency if this diagnostic is not "//& "needed.", default=" ", debuggingParam=.true.) call get_param(param_file, mdl, "HARMONIC_VISC", CS%harmonic_visc, & - "If true, use the harmonic mean thicknesses for \n"//& + "If true, use the harmonic mean thicknesses for "//& "calculating the vertical viscosity.", default=.false.) call get_param(param_file, mdl, "HARMONIC_BL_SCALE", CS%harm_BL_val, & - "A scale to determine when water is in the boundary \n"//& - "layers based solely on harmonic mean thicknesses for \n"//& - "the purpose of determining the extent to which the \n"//& + "A scale to determine when water is in the boundary "//& + "layers based solely on harmonic mean thicknesses for "//& + "the purpose of determining the extent to which the "//& "thicknesses used in the viscosities are upwinded.", & default=0.0, units="nondim") call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) if (GV%nkml < 1) & call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & - "The prescribed depth over which the near-surface \n"//& - "viscosity and diffusivity are elevated when the bulk \n"//& + "The prescribed depth over which the near-surface "//& + "viscosity and diffusivity are elevated when the bulk "//& "mixed layer is not used.", units="m", scale=GV%m_to_H, & unscaled=Hmix_m, fail_if_missing=.true.) if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & - "The depth over which the wind stress is applied if \n"//& + "The depth over which the wind stress is applied if "//& "DIRECT_STRESS is true.", units="m", default=Hmix_m, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & - "The depth over which the wind stress is applied if \n"//& + "The depth over which the wind stress is applied if "//& "DIRECT_STRESS is true.", units="m", fail_if_missing=.true., scale=GV%m_to_H) endif if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // & "HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.") endif call get_param(param_file, mdl, "KV", CS%Kv, & - "The background kinematic viscosity in the interior. \n"//& + "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m_to_Z**2, unscaled=Kv_dflt) if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & - "The kinematic viscosity in the mixed layer. A typical \n"//& - "value is ~1e-2 m2 s-1. KVML is not used if \n"//& + "The kinematic viscosity in the mixed layer. A typical "//& + "value is ~1e-2 m2 s-1. KVML is not used if "//& "BULKMIXEDLAYER is true. The default is set by KV.", & units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & - "The kinematic viscosity in the benthic boundary layer. \n"//& - "A typical value is ~1e-2 m2 s-1. KVBBL is not used if \n"//& + "The kinematic viscosity in the benthic boundary layer. "//& + "A typical value is ~1e-2 m2 s-1. KVBBL is not used if "//& "BOTTOMDRAGLAW is true. The default is set by KV.", & units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & - "The thickness of a bottom boundary layer with a \n"//& - "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& - "the thickness over which near-bottom velocities are \n"//& - "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& + "The thickness of a bottom boundary layer with a "//& + "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or "//& + "the thickness over which near-bottom velocities are "//& + "averaged for the drag law if BOTTOMDRAGLAW is defined "//& "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & - "The maximum velocity allowed before the velocity \n"//& + "The maximum velocity allowed before the velocity "//& "components are truncated.", units="m s-1", default=3.0e8) call get_param(param_file, mdl, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & - "If true, base truncations on the CFL number, and not an \n"//& + "If true, base truncations on the CFL number, and not an "//& "absolute speed.", default=.true.) call get_param(param_file, mdl, "CFL_TRUNCATE", CS%CFL_trunc, & - "The value of the CFL number that will cause velocity \n"//& + "The value of the CFL number that will cause velocity "//& "components to be truncated; instability can occur past 0.5.", & units="nondim", default=0.5) call get_param(param_file, mdl, "CFL_REPORT", CS%CFL_report, & - "The value of the CFL number that causes accelerations \n"//& + "The value of the CFL number that causes accelerations "//& "to be reported; the default is CFL_TRUNCATE.", & units="nondim", default=CS%CFL_trunc) call get_param(param_file, mdl, "CFL_TRUNCATE_RAMP_TIME", CS%truncRampTime, & - "The time over which the CFL truncation value is ramped\n"//& + "The time over which the CFL truncation value is ramped "//& "up at the beginning of the run.", & units="s", default=0.) 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\n"//& + "The start value of the truncation CFL number used when "//& "ramping up CFL_TRUNC.", & units="nondim", default=0.) call get_param(param_file, mdl, "STOKES_MIXING_COMBINED", CS%StokesMixing, & - "Flag to use Stokes drift Mixing via the Lagrangian \n"//& - " current (Eulerian plus Stokes drift). \n"//& + "Flag to use Stokes drift Mixing via the Lagrangian "//& + " current (Eulerian plus Stokes drift). "//& " Still needs work and testing, so not recommended for use.",& Default=.false.) !BGR 04/04/2018{ @@ -1719,14 +1719,14 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! MOM_error to use, but do so at your own risk and with these points in mind. !} if (CS%StokesMixing) then - call MOM_error(FATAL, "Stokes mixing requires user interfention in the code.\n"//& - " Model now exiting. See MOM_vert_friction.F90 for \n"//& + call MOM_error(FATAL, "Stokes mixing requires user intervention in the code.\n"//& + " Model now exiting. See MOM_vert_friction.F90 for \n"//& " details (search 'BGR 04/04/2018' to locate comment).") endif call get_param(param_file, mdl, "VEL_UNDERFLOW", CS%vel_underflow, & - "A negligibly small velocity magnitude below which velocity \n"//& - "components are set to 0. A reasonable value might be \n"//& - "1e-30 m/s, which is less than an Angstrom divided by \n"//& + "A negligibly small velocity magnitude below which velocity "//& + "components are set to 0. A reasonable value might be "//& + "1e-30 m/s, which is less than an Angstrom divided by "//& "the age of the universe.", units="m s-1", default=0.0) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 45eebb983e..90e59269d7 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -93,8 +93,8 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DOME_TRACER_IC_FILE", CS%tracer_IC_file, & - "The name of a file from which to read the initial \n"//& - "conditions for the DOME tracers, or blank to initialize \n"//& + "The name of a file from which to read the initial "//& + "conditions for the DOME tracers, or blank to initialize "//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") @@ -104,8 +104,8 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%tracer_IC_file) endif call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 36bc3edb65..deb5a78bea 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -97,8 +97,8 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ISOMIP_TRACER_IC_FILE", CS%tracer_IC_file, & - "The name of a file from which to read the initial \n"//& - "conditions for the ISOMIP tracers, or blank to initialize \n"//& + "The name of a file from which to read the initial "//& + "conditions for the ISOMIP tracers, or blank to initialize "//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") @@ -108,8 +108,8 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%tracer_IC_file) endif call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 805409c16b..43fe728d04 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -140,7 +140,7 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "CFC_IC_FILE", CS%IC_file, & - "The file in which the CFC initial values can be \n"//& + "The file in which the CFC initial values can be "//& "found, or an empty string for internal initialization.", & default=" ") if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then @@ -153,9 +153,9 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) "If true, CFC_IC_FILE is in depth space, not layer space", & default=.false.) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & - "If true, tracers may go through the initialization code \n"//& - "if they are not found in the restart files. Otherwise \n"//& - "it is a fatal error if tracers are not found in the \n"//& + "If true, tracers may go through the initialization code "//& + "if they are not found in the restart files. Otherwise "//& + "it is a fatal error if tracers are not found in the "//& "restart files of a restarted run.", default=.false.) ! The following vardesc types contain a package of metadata about each tracer, diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 2b732c5cc3..adfd60f664 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -134,7 +134,7 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, sub_name, version, "") call get_param(param_file, sub_name, "GENERIC_TRACER_IC_FILE", CS%IC_file, & - "The file in which the generic trcer initial values can \n"//& + "The file in which the generic trcer initial values can "//& "be found, or an empty string for internal initialization.", & default=" ") if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then @@ -144,12 +144,12 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call log_param(param_file, sub_name, "INPUTDIR/GENERIC_TRACER_IC_FILE", CS%IC_file) endif call get_param(param_file, sub_name, "GENERIC_TRACER_IC_FILE_IS_Z", CS%Z_IC_file, & - "If true, GENERIC_TRACER_IC_FILE is in depth space, not \n"//& + "If true, GENERIC_TRACER_IC_FILE is in depth space, not "//& "layer space.",default=.false.) call get_param(param_file, sub_name, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & - "If true, tracers may go through the initialization code \n"//& - "if they are not found in the restart files. Otherwise \n"//& - "it is a fatal error if tracers are not found in the \n"//& + "If true, tracers may go through the initialization code "//& + "if they are not found in the restart files. Otherwise "//& + "it is a fatal error if tracers are not found in the "//& "restart files of a restarted run.", default=.false.) CS%restart_CSp => restart_CS diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index d5a6f45c5f..deeb9529ee 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -137,54 +137,54 @@ logical function neutral_diffusion_init(Time, G, param_file, diag, EOS, CS) ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "NDIFF_CONTINUOUS", CS%continuous_reconstruction, & - "If true, uses a continuous reconstruction of T and S when \n"// & - "finding neutral surfaces along which diffusion will happen.\n"// & - "If false, a PPM discontinuous reconstruction of T and S \n"// & - "is done which results in a higher order routine but exacts \n"// & + "If true, uses a continuous reconstruction of T and S when "//& + "finding neutral surfaces along which diffusion will happen. "//& + "If false, a PPM discontinuous reconstruction of T and S "//& + "is done which results in a higher order routine but exacts "//& "a higher computational cost.", default=.true.) call get_param(param_file, mdl, "NDIFF_REF_PRES", CS%ref_pres, & - "The reference pressure (Pa) used for the derivatives of \n"// & - "the equation of state. If negative (default), local \n"// & + "The reference pressure (Pa) used for the derivatives of "//& + "the equation of state. If negative (default), local "//& "pressure is used.", & default = -1.) ! Initialize and configure remapping if (CS%continuous_reconstruction .eqv. .false.) then call get_param(param_file, mdl, "NDIFF_BOUNDARY_EXTRAP", boundary_extrap, & - "Uses a rootfinding approach to find the position of a\n"// & - "neutral surface within a layer taking into account the\n"// & - "nonlinearity of the equation of state and the\n"// & + "Uses a rootfinding approach to find the position of a "//& + "neutral surface within a layer taking into account the "//& + "nonlinearity of the equation of state and the "//& "polynomial reconstructions of T/S.", & default=.false.) call get_param(param_file, mdl, "NDIFF_REMAPPING_SCHEME", string, & - "This sets the reconstruction scheme used\n"//& - "for vertical remapping for all variables.\n"//& - "It can be one of the following schemes:\n"//& + "This sets the reconstruction scheme used "//& + "for vertical remapping for all variables. "//& + "It can be one of the following schemes: "//& trim(remappingSchemesDoc), default=remappingDefaultScheme) call initialize_remapping( CS%remap_CS, string, boundary_extrapolation = boundary_extrap ) call extract_member_remapping_CS(CS%remap_CS, degree=CS%deg) call get_param(param_file, mdl, "NDIFF_REFINE_POSITION", CS%refine_position, & - "Uses a rootfinding approach to find the position of a\n"// & - "neutral surface within a layer taking into account the\n"// & - "nonlinearity of the equation of state and the\n"// & + "Uses a rootfinding approach to find the position of a "//& + "neutral surface within a layer taking into account the "//& + "nonlinearity of the equation of state and the "//& "polynomial reconstructions of T/S.", & default=.false.) if (CS%refine_position) then call get_param(param_file, mdl, "NDIFF_DRHO_TOL", drho_tol, & - "Sets the convergence criterion for finding the neutral\n"// & + "Sets the convergence criterion for finding the neutral "//& "position within a layer in kg m-3.", & default=1.e-10) call get_param(param_file, mdl, "NDIFF_X_TOL", xtol, & - "Sets the convergence criterion for a change in nondim\n"// & + "Sets the convergence criterion for a change in nondim "//& "position within a layer.", & default=0.) call get_param(param_file, mdl, "NDIFF_MAX_ITER", max_iter, & - "The maximum number of iterations to be done before \n"// & + "The maximum number of iterations to be done before "//& "exiting the iterative loop to find the neutral surface", & default=10) call set_ndiff_aux_params(CS%ndiff_aux_CS, max_iter = max_iter, drho_tol = drho_tol, xtol = xtol) endif call get_param(param_file, mdl, "NDIFF_DEBUG", CS%debug, & - "Turns on verbose output for discontinuous neutral \n"// & + "Turns on verbose output for discontinuous neutral "//& "diffusion routines.", & default = .false.) call set_ndiff_aux_params(CS%ndiff_aux_CS, deg=CS%deg, ref_pres = CS%ref_pres, EOS = EOS, debug = CS%debug) diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index a4676583bd..00b61210fe 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -1313,27 +1313,27 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) call get_param(param_file, mdl, "DT_OFFLINE", CS%dt_offline, & "Length of time between reading in of input fields", 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\n" //& - "This should be set to the length of the coupling timestep for \n" //& + "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", 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, & - "True if the time-averaged fields and snapshot fields\n"//& + "True if the time-averaged fields and snapshot fields "//& "are offset by one time level", default=.false.) call get_param(param_file, mdl, "REDISTRIBUTE_METHOD", redistribute_method, & - "Redistributes any remaining horizontal fluxes throughout\n" //& - "the rest of water column. Options are 'barotropic' which\n" //& - "evenly distributes flux throughout the entire water column,\n" //& - "'upwards' which adds the maximum of the remaining flux in\n" //& - "each layer above, both which first applies upwards and then\n" //& + "Redistributes any remaining horizontal fluxes throughout " //& + "the rest of water column. Options are 'barotropic' which " //& + "evenly distributes flux throughout the entire water column, " //& + "'upwards' which adds the maximum of the remaining flux in " //& + "each layer above, both which first applies upwards and then " //& "barotropic, and 'none' which does no redistribution", & 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) call get_param(param_file, mdl, "OFF_ALE_MOD", CS%off_ale_mod, & - "Sets how many horizontal advection steps are taken before an ALE\n" //& + "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, & @@ -1350,21 +1350,21 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) "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\n" // & - "model would have when time-averaged fields of shortwave\n" // & + "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 \n"//& - "diffusivity from TKE-based parameterizations, or a \n"//& + "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) call get_param(param_file, mdl, "MIN_RESIDUAL_TRANSPORT", CS%min_residual, & - "How much remaining transport before the main offline advection\n"// & - "is exited. The default value corresponds to about 1 meter of\n" // & + "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) 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 \n" // & - "the model offline. This can require a large amount of memory\n"// & - "and will make initialization very slow. However, for offline\n"// & + "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.) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index a3c75bd7fd..d3e6abd00d 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -202,9 +202,8 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "USE_OCMIP2_CFC", CS%use_OCMIP2_CFC, & "If true, use the MOM_OCMIP2_CFC tracer package.", & default=.false.) - call get_param(param_file, mdl, "USE_generic_tracer", & - CS%use_MOM_generic_tracer, & - "If true and _USE_GENERIC_TRACER is defined as a \n"//& + call get_param(param_file, mdl, "USE_generic_tracer", CS%use_MOM_generic_tracer, & + "If true and _USE_GENERIC_TRACER is defined as a "//& "preprocessor macro, use the MOM_generic_tracer packages.", & default=.false.) call get_param(param_file, mdl, "USE_PSEUDO_SALT_TRACER", CS%use_pseudo_salt_tracer, & diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 50164bb3c3..261d8d1315 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -1403,8 +1403,8 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) "The background along-isopycnal tracer diffusivity.", & units="m2 s-1", default=0.0) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & - "The scaling coefficient for along-isopycnal tracer \n"//& - "diffusivity using a shear-based (Visbeck-like) \n"//& + "The scaling coefficient for along-isopycnal tracer "//& + "diffusivity using a shear-based (Visbeck-like) "//& "parameterization. A non-zero value enables this param.", & units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_MIN", CS%KhTr_Min, & @@ -1414,34 +1414,34 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) "The maximum along-isopycnal tracer diffusivity.", & units="m2 s-1", default=0.0) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & - "The coefficient that scales deformation radius over \n"//& - "grid-spacing in passivity, where passivity is the ratio \n"//& - "between along isopycnal mixing of tracers to thickness mixing. \n"//& + "The coefficient that scales deformation radius over "//& + "grid-spacing in passivity, where passivity is the ratio "//& + "between along isopycnal mixing of tracers to thickness mixing. "//& "A non-zero value enables this parameterization.", & units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_PASSIVITY_MIN", CS%KhTr_passivity_min, & - "The minimum passivity which is the ratio between \n"//& - "along isopycnal mixing of tracers to thickness mixing. \n", & + "The minimum passivity which is the ratio between "//& + "along isopycnal mixing of tracers to thickness mixing.", & units="nondim", default=0.5) call get_param(param_file, mdl, "DIFFUSE_ML_TO_INTERIOR", CS%Diffuse_ML_interior, & - "If true, enable epipycnal mixing between the surface \n"//& + "If true, enable epipycnal mixing between the surface "//& "boundary layer and the interior.", default=.false.) call get_param(param_file, mdl, "CHECK_DIFFUSIVE_CFL", CS%check_diffusive_CFL, & - "If true, use enough iterations the diffusion to ensure \n"//& - "that the diffusive equivalent of the CFL limit is not \n"//& - "violated. If false, always use the greater of 1 or \n"//& + "If true, use enough iterations the diffusion to ensure "//& + "that the diffusive equivalent of the CFL limit is not "//& + "violated. If false, always use the greater of 1 or "//& "MAX_TR_DIFFUSION_CFL iteration.", default=.false.) call get_param(param_file, mdl, "MAX_TR_DIFFUSION_CFL", CS%max_diff_CFL, & - "If positive, locally limit the along-isopycnal tracer \n"//& - "diffusivity to keep the diffusive CFL locally at or \n"//& - "below this value. The number of diffusive iterations \n"//& + "If positive, locally limit the along-isopycnal tracer "//& + "diffusivity to keep the diffusive CFL locally at or "//& + "below this value. The number of diffusive iterations "//& "is often this value or the next greater integer.", & units="nondim", default=-1.0) CS%ML_KhTR_scale = 1.0 if (CS%Diffuse_ML_interior) then call get_param(param_file, mdl, "ML_KHTR_SCALE", CS%ML_KhTR_scale, & - "With Diffuse_ML_interior, the ratio of the truly \n"//& - "horizontal diffusivity in the mixed layer to the \n"//& + "With Diffuse_ML_interior, the ratio of the truly "//& + "horizontal diffusivity in the mixed layer to the "//& "epipycnal diffusivity. The valid range is 0 to 1.", & units="nondim", default=1.0) endif diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 34f788c952..ee7340020c 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -99,16 +99,16 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ADVECTION_TEST_X_ORIGIN", CS%x_origin, & - "The x-coorindate of the center of the test-functions.\n", default=0.) + "The x-coorindate of the center of the test-functions.", default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_Y_ORIGIN", CS%y_origin, & - "The y-coorindate of the center of the test-functions.\n", default=0.) + "The y-coorindate of the center of the test-functions.", default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_X_WIDTH", CS%x_width, & - "The x-width of the test-functions.\n", default=0.) + "The x-width of the test-functions.", default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_Y_WIDTH", CS%y_width, & - "The y-width of the test-functions.\n", default=0.) + "The y-width of the test-functions.", default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_TRACER_IC_FILE", CS%tracer_IC_file, & - "The name of a file from which to read the initial \n"//& - "conditions for the tracers, or blank to initialize \n"//& + "The name of a file from which to read the initial "//& + "conditions for the tracers, or blank to initialize "//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then @@ -118,14 +118,14 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ CS%tracer_IC_file) endif call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & - "If true, tracers may go through the initialization code \n"//& - "if they are not found in the restart files. Otherwise \n"//& - "it is a fatal error if the tracers are not found in the \n"//& + "If true, tracers may go through the initialization code "//& + "if they are not found in the restart files. Otherwise "//& + "it is a fatal error if the tracers are not found in the "//& "restart files of a restarted run.", default=.false.) diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index fa95d8aa77..d007e18a16 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -99,14 +99,14 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "IMPULSE_SOURCE_TIME", CS%remaining_source_time, & - "Length of time for the boundary tracer to be injected\n"//& - "into the mixed layer. After this time has elapsed, the\n"//& + "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) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & - "If true, tracers may go through the initialization code \n"//& - "if they are not found in the restart files. Otherwise \n"//& - "it is a fatal error if the tracers are not found in the \n"//& + "If true, tracers may go through the initialization code "//& + "if they are not found in the restart files. Otherwise "//& + "it is a fatal error if the tracers are not found in the "//& "restart files of a restarted run.", default=.false.) CS%ntr = NTR_MAX allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 899d0cee67..285b9e2b41 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -99,7 +99,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "NUM_DYE_TRACERS", CS%ntr, & - "The number of dye tracers in this run. Each tracer \n"//& + "The number of dye tracers in this run. Each tracer "//& "should have a separate region.", default=0) allocate(CS%dye_source_minlon(CS%ntr), & CS%dye_source_maxlon(CS%ntr), & diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 7abbafa5fc..f2828bddc4 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -83,14 +83,14 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "NUM_DYE_TRACERS", CS%ntr, & - "The number of dye tracers in this run. Each tracer \n"//& + "The number of dye tracers in this run. Each tracer "//& "should have a separate boundary segment.", default=0) allocate(CS%ind_tr(CS%ntr)) allocate(CS%tr_desc(CS%ntr)) call get_param(param_file, mdl, "dyed_obc_TRACER_IC_FILE", CS%tracer_IC_file, & - "The name of a file from which to read the initial \n"//& - "conditions for the dyed_obc tracers, or blank to initialize \n"//& + "The name of a file from which to read the initial "//& + "conditions for the dyed_obc tracers, or blank to initialize "//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 562947a011..60463f9f1c 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -102,23 +102,23 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DO_IDEAL_AGE", do_ideal_age, & - "If true, use an ideal age tracer that is set to 0 age \n"//& + "If true, use an ideal age tracer that is set to 0 age "//& "in the mixed layer and ages at unit rate in the interior.", & default=.true.) call get_param(param_file, mdl, "DO_IDEAL_VINTAGE", do_vintage, & - "If true, use an ideal vintage tracer that is set to an \n"//& - "exponentially increasing value in the mixed layer and \n"//& + "If true, use an ideal vintage tracer that is set to an "//& + "exponentially increasing value in the mixed layer and "//& "is conserved thereafter.", default=.false.) call get_param(param_file, mdl, "DO_IDEAL_AGE_DATED", do_ideal_age_dated, & - "If true, use an ideal age tracer that is everywhere 0 \n"//& - "before IDEAL_AGE_DATED_START_YEAR, but the behaves like \n"//& - "the standard ideal age tracer - i.e. is set to 0 age in \n"//& + "If true, use an ideal age tracer that is everywhere 0 "//& + "before IDEAL_AGE_DATED_START_YEAR, but the behaves like "//& + "the standard ideal age tracer - i.e. is set to 0 age in "//& "the mixed layer and ages at unit rate in the interior.", & default=.false.) call get_param(param_file, mdl, "AGE_IC_FILE", CS%IC_file, & - "The file in which the age-tracer initial values can be \n"//& + "The file in which the age-tracer initial values can be "//& "found, or an empty string for internal initialization.", & default=" ") if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then @@ -131,9 +131,9 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "If true, AGE_IC_FILE is in depth space, not layer space", & default=.false.) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & - "If true, tracers may go through the initialization code \n"//& - "if they are not found in the restart files. Otherwise \n"//& - "it is a fatal error if the tracers are not found in the \n"//& + "If true, tracers may go through the initialization code "//& + "if they are not found in the restart files. Otherwise "//& + "it is a fatal error if the tracers are not found in the "//& "restart files of a restarted run.", default=.false.) CS%ntr = 0 diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 6156c20e24..f498ac4717 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -110,7 +110,7 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "OIL_IC_FILE", CS%IC_file, & - "The file in which the oil tracer initial values can be \n"//& + "The file in which the oil tracer initial values can be "//& "found, or an empty string for internal initialization.", & default=" ") if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then @@ -124,9 +124,9 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) default=.false.) call get_param(param_file, mdl, "OIL_MAY_REINIT", CS%oil_may_reinit, & - "If true, oil tracers may go through the initialization \n"//& - "code if they are not found in the restart files. \n"//& - "Otherwise it is a fatal error if the oil tracers are not \n"//& + "If true, oil tracers may go through the initialization "//& + "code if they are not found in the restart files. "//& + "Otherwise it is a fatal error if the oil tracers are not "//& "found in the restart files of a restarted run.", & default=.false.) call get_param(param_file, mdl, "OIL_SOURCE_LONGITUDE", CS%oil_source_longitude, & @@ -136,14 +136,14 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The geographic latitude of the oil source.", units="degrees N", & fail_if_missing=.true.) call get_param(param_file, mdl, "OIL_SOURCE_LAYER", CS%oil_source_k, & - "The layer into which the oil is introduced, or a \n"//& - "negative number for a vertically uniform source, \n"//& + "The layer into which the oil is introduced, or a "//& + "negative number for a vertically uniform source, "//& "or 0 not to use this tracer.", units="Layer", default=0) call get_param(param_file, mdl, "OIL_SOURCE_RATE", CS%oil_source_rate, & "The rate of oil injection.", units="kg s-1", default=1.0) call get_param(param_file, mdl, "OIL_DECAY_DAYS", CS%oil_decay_days, & - "The decay timescale in days (if positive), or no decay \n"//& - "if 0, or use the temperature dependent decay rate of \n"//& + "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", & default=0.0) call get_param(param_file, mdl, "OIL_DATED_START_YEAR", CS%oil_start_year, & diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 26ea3fb957..395857e0a1 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -87,8 +87,8 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "TRACER_EXAMPLE_IC_FILE", CS%tracer_IC_file, & - "The name of a file from which to read the initial \n"//& - "conditions for the DOME tracers, or blank to initialize \n"//& + "The name of a file from which to read the initial "//& + "conditions for the DOME tracers, or blank to initialize "//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") @@ -97,8 +97,8 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS CS%tracer_IC_file) endif call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & - "If true, sponges may be applied anywhere in the domain. \n"//& - "The exact location and properties of those sponges are \n"//& + "If true, sponges may be applied anywhere in the domain. "//& + "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 3d54df5955..65cf4bc90a 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -192,16 +192,16 @@ subroutine BFB_surface_forcing_init(Time, G, param_file, diag, 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, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "LFR_SLAT", CS%lfrslat, & @@ -224,13 +224,13 @@ subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) default=0.02) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index b81061ab29..a9a5be3d42 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -385,19 +385,19 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call get_param(param_file, mdl, "DOME2D_WEST_SPONGE_TIME_SCALE", dome2d_west_sponge_time_scale, & - 'The time-scale on the west edge of the domain for restoring T/S\n' //& + 'The time-scale on the west edge of the domain for restoring T/S '//& 'in the sponge. If zero, the western sponge is disabled', & units='s', default=0.) call get_param(param_file, mdl, "DOME2D_EAST_SPONGE_TIME_SCALE", dome2d_east_sponge_time_scale, & - 'The time-scale on the east edge of the domain for restoring T/S\n' //& + 'The time-scale on the east edge of the domain for restoring T/S '//& 'in the sponge. If zero, the eastern sponge is disabled', & units='s', default=0.) call get_param(param_file, mdl, "DOME2D_WEST_SPONGE_WIDTH", dome2d_west_sponge_width, & - 'The fraction of the domain in which the western sponge for restoring T/S\n' //& + 'The fraction of the domain in which the western sponge for restoring T/S '//& 'is active.', & units='nondim', default=0.1) call get_param(param_file, mdl, "DOME2D_EAST_SPONGE_WIDTH", dome2d_east_sponge_width, & - 'The fraction of the domain in which the eastern sponge for restoring T/S\n' //& + 'The fraction of the domain in which the eastern sponge for restoring T/S '//& 'is active.', & units='nondim', default=0.1) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 39c9321111..cce8b43a71 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -321,7 +321,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, case ( REGRIDDING_LAYER ) call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & - "If true, accept the prescribed temperature and fit the \n"//& + "If true, accept the prescribed temperature and fit the "//& "salinity; otherwise take salinity and fit temperature.", & default=.false., do_not_log=just_read) call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & @@ -628,16 +628,16 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can ! combined the *correct* temp and salt values in one file instead. call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & - "The name of the file with temps., salts. and interfaces to \n"// & + "The name of the file with temps., salts. and interfaces to "//& "damp toward.", fail_if_missing=.true.) call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & - "The name of the potential temperature variable in \n"//& + "The name of the potential temperature variable in "//& "SPONGE_STATE_FILE.", default="Temp") call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & - "The name of the salinity variable in \n"//& + "The name of the salinity variable in "//& "SPONGE_STATE_FILE.", default="Salt") call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & - "The name of the interface height variable in \n"//& + "The name of the interface height variable in "//& "SPONGE_STATE_FILE.", default="eta") !read temp and eta diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index b24ddc10cf..73d4a2ea1f 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -121,25 +121,25 @@ subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) ! Parameters for computing a wind profile call get_param(param_file, mdl, "IDL_HURR_RHO_AIR", CS%rho_a, & - "Air density used to compute the idealized hurricane"// & + "Air density used to compute the idealized hurricane "//& "wind profile.", units='kg/m3', default=1.2) call get_param(param_file, mdl, "IDL_HURR_AMBIENT_PRESSURE", & - CS%pressure_ambient, "Ambient pressure used in the "// & + CS%pressure_ambient, "Ambient pressure used in the "//& "idealized hurricane wind profile.", units='Pa', & default=101200.) call get_param(param_file, mdl, "IDL_HURR_CENTRAL_PRESSURE", & - CS%pressure_central, "Central pressure used in the "// & + CS%pressure_central, "Central pressure used in the "//& "idealized hurricane wind profile.", units='Pa', & default=96800.) call get_param(param_file, mdl, "IDL_HURR_RAD_MAX_WIND", & - CS%rad_max_wind, "Radius of maximum winds used in the"// & + CS%rad_max_wind, "Radius of maximum winds used in the "//& "idealized hurricane wind profile.", units='m', & default=50.e3) call get_param(param_file, mdl, "IDL_HURR_MAX_WIND", CS%max_windspeed, & "Maximum wind speed used in the idealized hurricane"// & "wind profile.", units='m/s', default=65.) call get_param(param_file, mdl, "IDL_HURR_TRAN_SPEED", CS%hurr_translation_spd, & - "Translation speed of hurricane used in the idealized"// & + "Translation speed of hurricane used in the idealized "//& "hurricane wind profile.", units='m/s', default=5.0) call get_param(param_file, mdl, "IDL_HURR_TRAN_DIR", CS%hurr_translation_dir, & "Translation direction (towards) of hurricane used in the "//& @@ -153,7 +153,7 @@ subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) "Idealized Hurricane initial Y position", & units='m', default=0.) call get_param(param_file, mdl, "IDL_HURR_TAU_CURR_REL", CS%relative_tau, & - "Current relative stress switch"// & + "Current relative stress switch "//& "used in the idealized hurricane wind profile.", & units='', default=.false.) @@ -163,20 +163,20 @@ subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) "invoking a modification (bug) in the wind profile meant to "//& "reproduce a previous implementation.", units='', default=.false.) call get_param(param_file, mdl, "IDL_HURR_SCM", CS%SCM_MODE, & - "Single Column mode switch"// & + "Single Column mode switch "//& "used in the SCM idealized hurricane wind profile.", & units='', default=.false.) call get_param(param_file, mdl, "IDL_HURR_SCM_LOCY", CS%DY_from_center, & - "Y distance of station used in the SCM idealized hurricane "// & + "Y distance of station used in the SCM idealized hurricane "//& "wind profile.", units='m', default=50.e3) ! The following parameters are model run-time parameters which are used ! and logged elsewhere and so should not be logged here. The default ! value should be consistent with the rest of the model. call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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, do_not_log=.true.) call get_param(param_file, mdl, "GUST_CONST", CS%gustiness, & diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 6114464bf5..7df6390c10 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -75,11 +75,11 @@ function register_Kelvin_OBC(param_file, CS, OBC_Reg) call get_param(param_file, mdl, "TOPO_CONFIG", config, do_not_log=.true.) if (trim(config) == "Kelvin") then call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_1", CS%coast_offset1, & - "The distance along the southern and northern boundaries \n"//& + "The distance along the southern and northern boundaries "//& "at which the coasts angle in.", & units="km", default=100.0) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", CS%coast_offset2, & - "The distance from the southern and northern boundaries \n"//& + "The distance from the southern and northern boundaries "//& "at which the coasts angle in.", & units="km", default=10.0) call get_param(param_file, mdl, "ROTATED_COAST_ANGLE", CS%coast_angle, & diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index a061fcb3eb..3ba4f0c376 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -509,11 +509,11 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call log_param(param_file, mdl, "CTRL_FORCE_INTEGRATED", do_integrated, & - "If true, use a PI controller to determine the surface \n"//& + "If true, use a PI controller to determine the surface "//& "forcing that is consistent with the observed mean properties.", & default=.false.) call log_param(param_file, mdl, "CTRL_FORCE_NUM_CYCLE", num_cycle, & - "The number of cycles per year in the controlled forcing, \n"//& + "The number of cycles per year in the controlled forcing, "//& "or 0 for no cyclic forcing.", default=0) if (.not.associated(CS)) return @@ -521,33 +521,33 @@ 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 \n"//& + "The integrated rate at which heat flux anomalies are "//& "accumulated.", units="s-1", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_PREC_INT_RATE", CS%prec_int_rate, & - "The integrated rate at which precipitation anomalies \n"//& + "The integrated rate at which precipitation anomalies "//& "are accumulated.", units="s-1", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_HEAT_CYC_RATE", CS%heat_cyc_rate, & - "The integrated rate at which cyclical heat flux \n"//& + "The integrated rate at which cyclical heat flux "//& "anomalies are accumulated.", units="s-1", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_PREC_CYC_RATE", CS%prec_cyc_rate, & - "The integrated rate at which cyclical precipitation \n"//& + "The integrated rate at which cyclical precipitation "//& "anomalies are accumulated.", units="s-1", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_SMOOTH_LENGTH", smooth_len, & - "The length scales over which controlled forcing \n"//& + "The length scales over which controlled forcing "//& "anomalies are smoothed.", units="m", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_HEAT", CS%lam_heat, & - "A constant of proportionality between SST anomalies \n"//& + "A constant of proportionality between SST anomalies "//& "and controlling heat fluxes", "W m-2 K-1", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_PREC", CS%lam_prec, & - "A constant of proportionality between SSS anomalies \n"//& + "A constant of proportionality between SSS anomalies "//& "(normalised by mean SSS) and controlling precipitation.", & "kg m-2", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_HEAT", CS%lam_cyc_heat, & - "A constant of proportionality between SST anomalies \n"//& + "A constant of proportionality between SST anomalies "//& "and cyclical controlling heat fluxes", "W m-2 K-1", default=0.0) call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_PREC", CS%lam_cyc_prec, & - "A constant of proportionality between SSS anomalies \n"//& - "(normalised by mean SSS) and cyclical controlling \n"//& + "A constant of proportionality between SSS anomalies "//& + "(normalised by mean SSS) and cyclical controlling "//& "precipitation.", "kg m-2", default=0.0) CS%Len2 = smooth_len**2 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index d08c9f42ca..3bfab9e4fc 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -302,9 +302,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) case (INPUT_STRING)! A method to input the Stokes band (globally uniform) DataSource = Input call get_param(param_file,mdl,"SURFBAND_NB",NumBands, & - "Prescribe number of wavenumber bands for Stokes drift. \n"// & - " Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and \n"// & - " STOKES_Y, there are no safety checks in the code.", & + "Prescribe number of wavenumber bands for Stokes drift. "// & + "Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and "// & + "STOKES_Y, there are no safety checks in the code.", & units='', default=1) allocate( CS%WaveNum_Cen(1:NumBands) ) CS%WaveNum_Cen(:) = 0.0 @@ -351,16 +351,16 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & - "The depth (normalized by BLD) to average Stokes drift over in \n"//& - " Langmuir number calculation, where La = sqrt(ust/Stokes).", & + "The depth (normalized by BLD) to average Stokes drift over in "//& + "Langmuir number calculation, where La = sqrt(ust/Stokes).", & units="nondim",default=0.04) call get_param(param_file, mdl, "LA_MISALIGNMENT", LA_Misalignment, & "Flag (logical) if using misalignment bt shear and waves in LA",& default=.false.) call get_param(param_file, mdl, "MIN_LANGMUIR", CS%La_min, & - "A minimum value for all Langmuir numbers that is not physical, \n"//& - " but is likely only encountered when the wind is very small and \n"//& - " therefore its effects should be mostly benign.",units="nondim",& + "A minimum value for all Langmuir numbers that is not physical, "//& + "but is likely only encountered when the wind is very small and "//& + "therefore its effects should be mostly benign.",units="nondim",& default=0.05) ! Allocate and initialize @@ -407,8 +407,8 @@ subroutine MOM_wave_interface_init_lite(param_file) ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & - "The depth (normalized by BLD) to average Stokes drift over in \n"//& - " Langmuir number calculation, where La = sqrt(ust/Stokes).", & + "The depth (normalized by BLD) to average Stokes drift over in "//& + "Langmuir number calculation, where La = sqrt(ust/Stokes).", & units="nondim",default=0.04) if (WaveMethod==NULL_WaveMethod) then diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 395c5e2119..ab964b5269 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -73,7 +73,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & - "The interface height scale associated with the \n"//& + "The interface height scale associated with the "//& "zonal-mean jet.", units="m", scale=US%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -147,7 +147,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & - "The interface height scale associated with the \n"//& + "The interface height scale associated with the "//& "zonal-mean jet.", units="m", scale=US%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -248,7 +248,7 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) "The width of the zonal-mean jet.", units="km", & fail_if_missing=.true.) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & - "The interface height scale associated with the \n"//& + "The interface height scale associated with the "//& "zonal-mean jet.", units="m", scale=US%m_to_Z, & fail_if_missing=.true.) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 4372586820..eb7f765890 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -60,15 +60,15 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para if (.not.just_read) call log_version(param_file, mdl, version, "") ! Parameters read by cartesian grid initialization call get_param(param_file, mdl, "DISK_RADIUS", diskrad, & - "The radius of the initially elevated disk in the \n"//& + "The radius of the initially elevated disk in the "//& "circle_obcs test case.", units=G%x_axis_units, & fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "DISK_X_OFFSET", xOffset, & - "The x-offset of the initially elevated disk in the \n"//& + "The x-offset of the initially elevated disk in the "//& "circle_obcs test case.", units=G%x_axis_units, & default = 0.0, do_not_log=just_read) call get_param(param_file, mdl, "DISK_IC_AMPLITUDE", IC_amp, & - "Initial amplitude of interface height displacements \n"//& + "Initial amplitude of interface height displacements "//& "in the circle_obcs test case.", & units='m', default=5.0, scale=GV%m_to_H, do_not_log=just_read) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index c6e6354ef3..b16b3a341c 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -132,7 +132,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & - "The granularity of initial interface height values \n"//& + "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & default=2048.0, units="m-1", scale=US%Z_to_m, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -220,7 +220,7 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file 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, & - 'Initial profile shape. Valid values are "linear", "parabolic"\n'// & + 'Initial profile shape. Valid values are "linear", "parabolic" '// & 'and "exponential".', default='linear', do_not_log=just_read) call get_param(param_file, mdl,"DUMBBELL_SREF", S_surf, & 'DUMBBELL REFERENCE SALINITY', units='1e-3', default=34., do_not_log=just_read) diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 7a2360fc7a..6d3e46bd73 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -203,16 +203,16 @@ subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, 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, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "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) call get_param(param_file, mdl, "DUMBBELL_SLP_AMP", CS%slp_amplitude, & @@ -231,13 +231,13 @@ subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) default=2., do_not_log=.true.) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back \n"//& - "toward some specified surface state with a rate \n"//& + "If true, the buoyancy fluxes drive the model back "//& + "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) ! Convert CS%Flux_const from m day-1 to m s-1. diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index cb1b9a6b2f..61f8183275 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -101,7 +101,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) 'dyed_channel_set_OBC_data() was called but OBC type was not initialized!') call get_param(param_file, mdl, "NUM_DYE_TRACERS", ntr, & - "The number of dye tracers in this run. Each tracer \n"//& + "The number of dye tracers in this run. Each tracer "//& "should have a separate boundary segment.", default=0, & do_not_log=.true.) diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index eed0f804b4..39519ce8a6 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -52,7 +52,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg) if (.not.associated(OBC)) return call get_param(param_file, mdl, "NUM_DYE_TRACERS", ntr, & - "The number of dye tracers in this run. Each tracer \n"//& + "The number of dye tracers in this run. Each tracer "//& "should have a separate boundary segment.", default=0, & do_not_log=.true.) diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index c442f63891..1a3e8dd308 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -56,12 +56,12 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "FRONT_DISPLACEMENT", front_displacement, & - "The vertical displacement of interfaces across the front. \n"//& + "The vertical displacement of interfaces across the front. "//& "A value larger in magnitude that MAX_DEPTH is truncated,", & units="m", fail_if_missing=.not.just_read, do_not_log=just_read, scale=US%m_to_Z) call get_param(param_file, mdl, "THERMOCLINE_THICKNESS", thermocline_thickness, & - "The thickness of the thermocline in the lock exchange \n"//& - "experiment. A value of zero creates a two layer system \n"//& + "The thickness of the thermocline in the lock exchange "//& + "experiment. A value of zero creates a two layer system "//& "with vanished layers in between the two inflated layers.", & default=0., units="m", do_not_log=just_read, scale=US%m_to_Z) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 6180ff2e00..0df24efb42 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -53,11 +53,11 @@ subroutine seamount_initialize_topography( D, G, param_file, max_depth ) "Non-dimensional height of seamount.", & units="non-dim", default=0.5) call get_param(param_file, mdl,"SEAMOUNT_X_LENGTH_SCALE",Lx, & - "Length scale of seamount in x-direction.\n"//& + "Length scale of seamount in x-direction. "//& "Set to zero make topography uniform in the x-direction.", & units="Same as x,y", default=20.) call get_param(param_file, mdl,"SEAMOUNT_Y_LENGTH_SCALE",Ly, & - "Length scale of seamount in y-direction.\n"//& + "Length scale of seamount in y-direction. "//& "Set to zero make topography uniform in the y-direction.", & units="Same as x,y", default=0.) @@ -132,7 +132,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & - "The granularity of initial interface height values \n"//& + "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & default=2048.0, units="m-1", scale=US%Z_to_m, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -217,7 +217,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file 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, & - 'Initial profile shape. Valid values are "linear", "parabolic"\n'// & + 'Initial profile shape. Valid values are "linear", "parabolic" '//& 'and "exponential".', default='linear', do_not_log=just_read) call get_param(param_file, mdl,"INITIAL_SSS", S_surf, & 'Initial surface salinity', units='1e-3', default=34., do_not_log=just_read) diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 1a52519122..cd80514bea 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -69,7 +69,7 @@ function register_shelfwave_OBC(param_file, CS, OBC_Reg) "Length scale of shelfwave in x-direction.",& units="Same as x,y", default=100.) call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",CS%Ly, & - "Length scale of exponential dropoff of topography\n"//& + "Length scale of exponential dropoff of topography "//& "in the y-direction.", & units="Same as x,y", default=50.) call get_param(param_file, mdl,"SHELFWAVE_Y_MODE",CS%jj, & diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 990d43fda4..e099d808d5 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -84,7 +84,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p 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 \n"//& + "Initial amplitude of sloshing internal interface height "//& "displacements it the sloshing test case.", & units='m', default=75.0, scale=US%m_to_Z, do_not_log=just_read) call get_param(param_file, mdl, "SLOSHING_IC_BUG", use_IC_bug, & diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 9cb92ebc3c..10d04af0c3 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -221,26 +221,26 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, 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, "USER_KD_ADD", CS%Kd_add, & - "A user-specified additional diffusivity over a range of \n"//& + "A user-specified additional diffusivity over a range of "//& "latitude and density.", default=0.0, units="m2 s-1", & scale=US%m2_s_to_Z2_T) if (CS%Kd_add /= 0.0) then call get_param(param_file, mdl, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), & - "Four successive values that define a range of latitudes \n"//& - "over which the user-specified extra diffusivity is \n"//& - "applied. The four values specify the latitudes at \n"//& - "which the extra diffusivity starts to increase from 0, \n"//& - "hits its full value, starts to decrease again, and is \n"//& + "Four successive values that define a range of latitudes "//& + "over which the user-specified extra diffusivity is "//& + "applied. The four values specify the latitudes at "//& + "which the extra diffusivity starts to increase from 0, "//& + "hits its full value, starts to decrease again, and is "//& "back to 0.", units="degree", default=-1.0e9) call get_param(param_file, mdl, "USER_KD_ADD_RHO_RANGE", CS%rho_range(:), & - "Four successive values that define a range of potential \n"//& - "densities over which the user-given extra diffusivity \n"//& - "is applied. The four values specify the density at \n"//& - "which the extra diffusivity starts to increase from 0, \n"//& - "hits its full value, starts to decrease again, and is \n"//& + "Four successive values that define a range of potential "//& + "densities over which the user-given extra diffusivity "//& + "is applied. The four values specify the density at "//& + "which the extra diffusivity starts to increase from 0, "//& + "hits its full value, starts to decrease again, and is "//& "back to 0.", units="kg m-3", default=-1.0e9) call get_param(param_file, mdl, "USER_KD_ADD_USE_ABS_LAT", CS%use_abs_lat, & - "If true, use the absolute value of latitude when \n"//& + "If true, use the absolute value of latitude when "//& "checking whether a point fits into range of latitudes.", & default=.false.) endif From eaf8c906b00696fc2b5ac737c577e40b2734fcec Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 21 May 2019 10:06:51 -0400 Subject: [PATCH 065/106] + Excise of legacy z-interpolated diagnostics This patch removes the older method for computing diagnostics onto z-levels (depth space), associated with modules ending in `_zold`. These diagnostics are being removed for two reasons: 1. The tests are now integrated into the diagnostic mediator, and are now redundant. 2. The diagnostics did not consistently handle masked values correctly, which was causing issues with checksum calculations. This patch also removes the diag_to_Z_CS control structure and its reference in some functions, causing an API change. The parameter MIN_Z_DIAG_INTERVAL has also been made obsolete, since it was used to control the output of some depth-space diagnostics. Two subroutines in MOM_diag_to_Z.F90 (to be removed) were used in MOM_tracer_flow_control.F90: * find_overlap * find_limited_slope so they have been moved to this file. We also note that there are nearly identical subroutines in midas_vertmap.F90, which could be merged at some point. This patch will break existing tests, since many use MIN_Z_DIAG_INTERVAL and several `_zold` diagnostics, and will need to be modified before this can be merged. --- src/core/MOM.F90 | 39 +- src/diagnostics/MOM_diag_to_Z.F90 | 1351 ----------------- src/diagnostics/MOM_diagnostics.F90 | 9 +- src/diagnostics/MOM_obsolete_params.F90 | 2 + .../vertical/MOM_diabatic_driver.F90 | 113 +- .../vertical/MOM_internal_tide_input.F90 | 1 - .../vertical/MOM_set_diffusivity.F90 | 87 +- .../vertical/MOM_tidal_mixing.F90 | 67 +- src/tracer/DOME_tracer.F90 | 5 +- src/tracer/ISOMIP_tracer.F90 | 5 +- src/tracer/MOM_OCMIP2_CFC.F90 | 5 +- src/tracer/MOM_generic_tracer.F90 | 57 +- src/tracer/MOM_tracer_Z_init.F90 | 100 +- src/tracer/MOM_tracer_flow_control.F90 | 30 +- src/tracer/MOM_tracer_registry.F90 | 13 +- src/tracer/advection_test_tracer.F90 | 5 +- src/tracer/boundary_impulse_tracer.F90 | 5 +- src/tracer/dye_example.F90 | 6 +- src/tracer/dyed_obc_tracer.F90 | 5 +- src/tracer/ideal_age_example.F90 | 6 +- src/tracer/oil_tracer.F90 | 5 +- src/tracer/pseudo_salt_tracer.F90 | 5 +- src/tracer/tracer_example.F90 | 5 +- 23 files changed, 161 insertions(+), 1765 deletions(-) delete mode 100644 src/diagnostics/MOM_diag_to_Z.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4762e9f26d..b78cbd82ac 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -60,8 +60,6 @@ module MOM use MOM_diagnostics, only : register_surface_diags, write_static_fields use MOM_diagnostics, only : post_surface_dyn_diags, post_surface_thermo_diags use MOM_diagnostics, only : diagnostics_CS, surface_diag_IDs, transport_diag_IDs -use MOM_diag_to_Z, only : calculate_Z_diag_fields, register_Z_tracer -use MOM_diag_to_Z, only : MOM_diag_to_Z_init, MOM_diag_to_Z_end, diag_to_Z_CS use MOM_dynamics_unsplit, only : step_MOM_dyn_unsplit, register_restarts_dyn_unsplit use MOM_dynamics_unsplit, only : initialize_dyn_unsplit, end_dyn_unsplit use MOM_dynamics_unsplit, only : MOM_dyn_unsplit_CS @@ -246,9 +244,6 @@ module MOM type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. - type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics - type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics - 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]. @@ -352,8 +347,6 @@ module MOM !< Pointer to the globally summed output control structure type(diagnostics_CS), pointer :: diagnostics_CSp => NULL() !< Pointer to the MOM diagnostics control structure - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() - !< Pointer to the MOM Z-space diagnostics control structure type(offline_transport_CS), pointer :: offline_CSp => NULL() !< Pointer to the offline tracer transport control structure @@ -797,18 +790,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call disable_averaging(CS%diag) CS%t_dyn_rel_diag = 0.0 - call cpu_clock_begin(id_clock_Z_diag) - if (Time_local + real_to_time(0.5*dt_therm) > CS%Z_diag_time) then - call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), & - CS%Z_diag_time, CS%diag) - !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? - call calculate_Z_diag_fields(u, v, h, ssh, fluxes%frac_shelf_h, & - G, GV, US, CS%diag_to_Z_CSp) - CS%Z_diag_time = CS%Z_diag_time + CS%Z_diag_interval - call disable_averaging(CS%diag) - if (showCallTree) call callTree_waypoint("finished calculate_Z_diag_fields (step_MOM)") - endif - call cpu_clock_end(id_clock_Z_diag) call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) endif @@ -1111,7 +1092,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) call post_transport_diagnostics(G, GV, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & - CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%diag_to_Z_CSp, CS%tracer_reg) + CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%tracer_reg) ! Rebuild the remap grids now that we've posted the fields which rely on thicknesses ! from before the dynamics calls call diag_update_remap_grids(CS%diag) @@ -1793,11 +1774,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& "melt potential will not be computed.", units="m", default=-1.0) - call get_param(param_file, "MOM", "MIN_Z_DIAG_INTERVAL", Z_diag_int, & - "The minimum amount of time in seconds between \n"//& - "calculations of depth-space diagnostics. Making this \n"//& - "larger than DT_THERM reduces the performance penalty \n"//& - "of regridding to depth online.", units="s", default=0.0) call get_param(param_file, "MOM", "INTERPOLATE_P_SURF", CS%interp_p_surf, & "If true, linearly interpolate the surface pressure \n"//& "over the coupling time step, using the specified value \n"//& @@ -2365,11 +2341,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - CS%Z_diag_interval = real_to_time(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) - call MOM_diag_to_Z_init(Time, G, GV, US, param_file, diag, CS%diag_to_Z_CSp) - CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + & - ((Time + real_to_time(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) - if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) @@ -2378,11 +2349,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%adiabatic) then call adiabatic_driver_init(Time, G, param_file, diag, CS%diabatic_CSp, & - CS%tracer_flow_CSp, CS%diag_to_Z_CSp) + CS%tracer_flow_CSp) else call diabatic_driver_init(Time, G, GV, US, param_file, CS%use_ALE_algorithm, diag, & CS%ADp, CS%CDp, CS%diabatic_CSp, CS%tracer_flow_CSp, & - CS%sponge_CSp, CS%ALE_sponge_CSp, CS%diag_to_Z_CSp) + CS%sponge_CSp, CS%ALE_sponge_CSp) endif call tracer_advect_init(Time, G, param_file, diag, CS%tracer_adv_CSp) @@ -2397,7 +2368,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_diags(Time, G, GV, CS%IDs, CS%diag) call register_transport_diags(Time, G, GV, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & - CS%use_ALE_algorithm, CS%diag_to_Z_CSp) + CS%use_ALE_algorithm) if (CS%use_ALE_algorithm) then call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp) endif @@ -2406,7 +2377,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & new_sim = is_new_run(restart_CSp) call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, & CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & - CS%ALE_sponge_CSp, CS%diag_to_Z_CSp, CS%tv) + CS%ALE_sponge_CSp, CS%tv) if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp ! If running in offline tracer mode, initialize the necessary control structure and diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 deleted file mode 100644 index 3c50f00061..0000000000 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ /dev/null @@ -1,1351 +0,0 @@ -!> Maps tracers and velocities into depth space for output as diagnostic quantities. -!! -!! Currently, a piecewise linear subgrid structure is used for tracers, while velocities can -!! use either piecewise constant or piecewise linear structures. -module MOM_diag_to_Z - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_coms, only : reproducing_sum -use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr -use MOM_diag_mediator, only : diag_ctrl, time_type, diag_axis_init -use MOM_diag_mediator, only : axes_grp, define_axes_group -use MOM_diag_mediator, only : ocean_register_diag -use MOM_domains, only : pass_var -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_grid, only : ocean_grid_type -use MOM_io, only : slasher, vardesc, query_vardesc, modify_vardesc -use MOM_spatial_means, only : global_layer_mean -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : p3d, p2d -use MOM_verticalGrid, only : verticalGrid_type - -use netcdf - -implicit none ; private - -#include - -public calculate_Z_diag_fields -public register_Z_tracer -public MOM_diag_to_Z_init -public calculate_Z_transport -public MOM_diag_to_Z_end -public ocean_register_diag_with_z -public find_overlap -public find_limited_slope -public register_Zint_diag -public calc_Zint_diags - -! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional -! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units -! vary with the Boussinesq approximation, the Boussinesq variant is given first. - -!> The control structure for the MOM_diag_to_Z module -type, public :: diag_to_Z_CS ; private - ! The following arrays are used to store diagnostics calculated in this - ! module and unavailable outside of it. - - real, pointer, dimension(:,:,:) :: & - u_z => NULL(), & !< zonal velocity remapped to depth space [m s-1] - v_z => NULL(), & !< meridional velocity remapped to depth space [m s-1] - uh_z => NULL(), & !< zonal transport remapped to depth space [H m2 s-1 ~> m3 s-1 or kg s-1] - vh_z => NULL() !< meridional transport remapped to depth space [H m2 s-1 ~> m3 s-1 or kg s-1] - - type(p3d) :: tr_z(MAX_FIELDS_) !< array of tracers, remapped to depth space - type(p3d) :: tr_model(MAX_FIELDS_) !< pointers to an array of tracers - - real :: missing_vel = -1.0e34 !< Missing variable fill values for velocities - real :: missing_trans = -1.0e34 !< Missing variable fill values for transports - real :: missing_tr(MAX_FIELDS_) = -1.0e34 !< Missing variable fill values for tracers - real :: missing_value = -1.0e34 !< Missing variable fill values for other diagnostics - - integer :: id_u_z = -1 !< Diagnostic ID for zonal velocity - integer :: id_v_z = -1 !< Diagnostic ID for meridional velocity - integer :: id_uh_Z = -1 !< Diagnostic ID for zonal transports - integer :: id_vh_Z = -1 !< Diagnostic ID for meridional transports - integer :: id_tr(MAX_FIELDS_) = -1 !< Diagnostic IDs for tracers - integer :: id_tr_xyave(MAX_FIELDS_) = -1 !< Diagnostic IDs for spatially averaged tracers - - integer :: num_tr_used = 0 !< Th enumber of tracers in use. - integer :: nk_zspace = -1 !< The number of levels in the z-space output - - real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file [Z ~> m]. - - !>@{ Axis groups for z-space diagnostic output - type(axes_grp) :: axesBz, axesTz, axesCuz, axesCvz - type(axes_grp) :: axesBzi, axesTzi, axesCuzi, axesCvzi - type(axes_grp) :: axesZ - !!@} - integer, dimension(1) :: axesz_out - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - -end type diag_to_Z_CS - -integer, parameter :: NO_ZSPACE = -1 !< Flag to enable z-space? - -contains - -!> Return the global horizontal mean in z-space -function global_z_mean(var, G, GV, US, CS, tracer) - 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(diag_to_Z_CS), pointer :: CS !< Control structure returned by - !! previous call to diag_to_Z_init. - real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace), & - intent(in) :: var !< An array with the variable to average - integer, intent(in) :: tracer !< The tracer index being worked on - ! Local variables - real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace) :: tmpForSumming, weight - real, dimension(CS%nk_zspace) :: global_z_mean, scalarij, weightij - real, dimension(CS%nk_zspace) :: global_temp_scalar, global_weight_scalar - real :: valid_point, depth_weight - integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - nz = CS%nk_zspace - - ! Initialize local arrays - tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0. - - do k=1,nz ; do j=js,je ; do i=is,ie - valid_point = 1.0 - ! Weight factor for partial bottom cells - depth_weight = min( max(-G%bathyT(i,j), CS%Z_int(k+1)) - CS%Z_int(k), 0.) - - ! Flag the point as invalid if it contains missing data, or is below the bathymetry - if (var(i,j,k) == CS%missing_tr(tracer)) valid_point = 0. - if (depth_weight == 0.) valid_point = 0. - - weight(i,j,k) = US%Z_to_m * depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) - - ! If the point is flagged, set the variable itself to zero to avoid NaNs - if (valid_point == 0.) then - tmpForSumming(i,j,k) = 0.0 - else - tmpForSumming(i,j,k) = var(i,j,k) * weight(i,j,k) - endif - enddo ; enddo ; enddo - - global_temp_scalar = reproducing_sum(tmpForSumming, sums=scalarij) - global_weight_scalar = reproducing_sum(weight, sums=weightij) - - do k=1, nz - if (scalarij(k) == 0) then - global_z_mean(k) = 0.0 - else - global_z_mean(k) = scalarij(k) / weightij(k) - endif - enddo - -end function global_z_mean - -!> This subroutine maps tracers and velocities into depth space for diagnostics. -subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh_in !< Sea surface height in meters. - real, dimension(:,:), pointer :: frac_shelf_h !< The fraction of the cell area covered by - !! ice shelf, or unassocatiaed if there is no shelf - type(diag_to_Z_CS), pointer :: CS !< Control structure returned by a previous call - !! to diag_to_Z_init. - ! Local variables - ! Note the deliberately reversed axes in h_f, u_f, v_f, and tr_f. - real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in whose halos can be updated [H ~> m or kg m-2] - real :: e(SZK_(G)+2) ! z-star interface heights [Z ~> m]. - real :: h_f(SZK_(G)+1,SZI_(G)) ! thicknesses of massive layers [H ~> m or kg m-2] - real :: u_f(SZK_(G)+1,SZIB_(G))! zonal velocity component in any massive layer - real :: v_f(SZK_(G)+1,SZI_(G)) ! meridional velocity component in any massive layer - - real :: tr_f(SZK_(G),max(CS%num_tr_used,1),SZI_(G)) ! tracer concentration in massive layers - integer :: nk_valid(SZIB_(G)) ! number of massive layers in a column - - real :: D_pt(SZIB_(G)) ! bottom depth [Z ~> m]. - real :: shelf_depth(SZIB_(G)) ! ice shelf depth [Z ~> m]. - real :: htot ! summed layer thicknesses [H ~> m or kg m-2] - real :: dilate ! proportion by which to dilate every layer - real :: wt(SZK_(G)+1) ! fractional weight for each layer in the - ! range between k_top and k_bot [nondim] - real :: z1(SZK_(G)+1) ! z1 and z2 are the depths of the top and bottom - real :: z2(SZK_(G)+1) ! limits of the part of a layer that contributes - ! to a depth level, relative to the cell center - ! and normalized by the cell thickness [nondim] - ! Note that -1/2 <= z1 < z2 <= 1/2. - real :: sl_tr(max(CS%num_tr_used,1)) ! normalized slope of the tracer - ! within the cell, in tracer units - real :: Angstrom ! A minimal layer thickness [H ~> m or kg m-2]. - real :: slope ! normalized slope of a variable within the cell - - real :: layer_ave(CS%nk_zspace) - - logical :: linear_velocity_profiles, ice_shelf - - integer :: k_top, k_bot, k_bot_prev - integer :: i, j, k, k2, kz, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nk, m, nkml - integer :: IsgB, IegB, JsgB, JegB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nk = G%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - IsgB = G%IsgB ; IegB = G%IegB ; JsgB = G%JsgB ; JegB = G%JegB - nkml = max(GV%nkml, 1) - Angstrom = GV%Angstrom_H - linear_velocity_profiles = .true. - - - if (.not.associated(CS)) call MOM_error(FATAL, & - "diagnostic_fields_zstar: Module must be initialized before it is used.") - - ice_shelf = associated(frac_shelf_h) - - ! Update the halos - if (ice_shelf) then - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; ssh(i,j) = US%m_to_Z*ssh_in(i,j) ; enddo ; enddo - call pass_var(ssh, G%Domain) - endif - - ! If no fields are needed, return - if ((CS%id_u_z <= 0) .and. (CS%id_v_z <= 0) .and. (CS%num_tr_used < 1)) return - - ! zonal velocity component - if (CS%id_u_z > 0) then - - do kz=1,CS%nk_zspace ; do j=js,je ; do I=Isq,Ieq - CS%u_z(I,j,kz) = CS%missing_vel - enddo ; enddo ; enddo - - - do j=js,je - shelf_depth(:) = 0. ! initially all is open ocean - ! Remove all massless layers. - do I=Isq,Ieq - nk_valid(I) = 0 - D_pt(I) = 0.5*(G%bathyT(i+1,j)+G%bathyT(i,j)) - if (ice_shelf) then - if (frac_shelf_h(i,j)+frac_shelf_h(i+1,j) > 0.) then ! under shelf - shelf_depth(I) = abs(0.5*(ssh(i+1,j)+ssh(i,j))) - endif - endif - enddo - do k=1,nk ; do I=Isq,Ieq - if ((G%mask2dCu(I,j) > 0.5) .and. (h(i,j,k)+h(i+1,j,k) > 4.0*Angstrom)) then - nk_valid(I) = nk_valid(I) + 1 ; k2 = nk_valid(I) - h_f(k2,I) = 0.5*(h(i,j,k)+h(i+1,j,k)) ; u_f(k2,I) = u(I,j,k) - endif - enddo ; enddo - do I=Isq,Ieq ; if (G%mask2dCu(I,j) > 0.5) then - ! Add an Angstrom thick layer at the bottom with 0 velocity to impose a - ! no-slip BBC in the output, if anything but piecewise constant is used. - nk_valid(I) = nk_valid(I) + 1 ; k2 = nk_valid(I) - h_f(k2,I) = Angstrom ; u_f(k2,I) = 0.0 - ! GM: D_pt is always slightly larger (by 1E-6 or so) than shelf_depth, so - ! I consider that the ice shelf is grounded for diagnostic purposes when - ! shelf_depth(I) + 1.0E-3*US%m_to_Z > D_pt(i) - if (ice_shelf .and. (shelf_depth(I) + 1.0E-3*US%m_to_Z > D_pt(i))) nk_valid(I)=0 - endif ; enddo - - - do I=Isq,Ieq ; if (nk_valid(I) > 0) then - ! Calculate the z* interface heights for tracers. - htot = 0.0 ; do k=1,nk_valid(i) ; htot = htot + h_f(k,i) ; enddo - dilate = 0.0 - if (htot > 2.0*Angstrom) then - dilate = MAX((D_pt(i) - shelf_depth(i)), GV%Angstrom_Z)/htot - endif - e(nk_valid(i)+1) = -D_pt(i) - do k=nk_valid(i),1,-1 ; e(K) = e(K+1) + h_f(k,i)*dilate ; enddo - - ! Interpolate each variable into depth space. - k_bot = 1 ; k_bot_prev = -1 - do kz=1,CS%nk_zspace - call find_overlap(e, CS%Z_int(kz), CS%Z_int(kz+1), nk_valid(I), & - k_bot, k_top, k_bot, wt, z1, z2) - if (k_top>nk_valid(I)) exit - - !GM if top range that is being map is below the shelf, interpolate - ! otherwise keep missing_vel - if (CS%Z_int(kz)<=-shelf_depth(I)) then - - if (linear_velocity_profiles) then - k = k_top - if (k /= k_bot_prev) then - ! Calculate the intra-cell profile. - slope = 0.0 ! ; curv = 0.0 - if ((k < nk_valid(I)) .and. (k > nkml)) call & - find_limited_slope(u_f(:,I), e, slope, k) - endif - ! This is the piecewise linear form. - CS%u_z(I,j,kz) = wt(k) * (u_f(k,I) + 0.5*slope*(z2(k) + z1(k))) - ! For the piecewise parabolic form add the following... - ! + C1_3*curv*(z2(k)**2 + z2(k)*z1(k) + z1(k)**2)) - do k=k_top+1,k_bot-1 - CS%u_z(I,j,kz) = CS%u_z(I,j,kz) + wt(k)*u_f(k,I) - enddo - if (k_bot > k_top) then ; k = k_bot - ! Calculate the intra-cell profile. - slope = 0.0 ! ; curv = 0.0 - if ((k < nk_valid(I)) .and. (k > nkml)) call & - find_limited_slope(u_f(:,I), e, slope, k) - ! This is the piecewise linear form. - CS%u_z(I,j,kz) = CS%u_z(I,j,kz) + wt(k) * & - (u_f(k,I) + 0.5*slope*(z2(k) + z1(k))) - ! For the piecewise parabolic form add the following... - ! + C1_3*curv*(z2(k)**2 + z2(k)*z1(k) + z1(k)**2)) - endif - k_bot_prev = k_bot - else ! Use piecewise constant profiles. - CS%u_z(I,j,kz) = wt(k_top)*u_f(k_top,I) - do k=k_top+1,k_bot - CS%u_z(I,j,kz) = CS%u_z(I,j,kz) + wt(k)*u_f(k,I) - enddo - endif ! linear profiles - endif ! below shelf - enddo ! kz-loop - endif ; enddo ! I-loop and mask - enddo ! j-loop - - call post_data(CS%id_u_z, CS%u_z, CS%diag) - endif - - ! meridional velocity component - if (CS%id_v_z > 0) then - do kz=1,CS%nk_zspace ; do J=Jsq,Jeq ; do i=is,ie - CS%v_z(i,J,kz) = CS%missing_vel - enddo ; enddo ; enddo - - do J=Jsq,Jeq - shelf_depth(:) = 0.0 ! initially all is open ocean - ! Remove all massless layers. - do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = 0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) - if (ice_shelf) then - if (frac_shelf_h(i,j)+frac_shelf_h(i,j+1) > 0.) then ! under shelf - shelf_depth(i) = abs(0.5*(ssh(i,j)+ssh(i,j+1))) - endif - endif - enddo - do k=1,nk ; do i=is,ie - if ((G%mask2dCv(i,j) > 0.5) .and. (h(i,j,k)+h(i,j+1,k) > 4.0*Angstrom)) then - nk_valid(i) = nk_valid(i) + 1 ; k2 = nk_valid(i) - h_f(k2,i) = 0.5*(h(i,j,k)+h(i,j+1,k)) ; v_f(k2,i) = v(i,j,k) - endif - enddo ; enddo - do i=is,ie ; if (G%mask2dCv(i,j) > 0.5) then - ! Add an Angstrom thick layer at the bottom with 0 velocity to impose a - ! no-slip BBC in the output, if anything but piecewise constant is used. - nk_valid(i) = nk_valid(i) + 1 ; k2 = nk_valid(i) - h_f(k2,i) = Angstrom ; v_f(k2,i) = 0.0 - if (ice_shelf .and. shelf_depth(i) + 1.0E-3*US%m_to_Z > D_pt(i)) nk_valid(I)=0 - endif ; enddo - - do i=is,ie ; if (nk_valid(i) > 0) then - ! Calculate the z* interface heights for tracers. - htot = 0.0 ; do k=1,nk_valid(i) ; htot = htot + h_f(k,i) ; enddo - dilate = 0.0 - if (htot > 2.0*Angstrom) then - dilate = MAX((D_pt(i) - shelf_depth(i)), GV%Angstrom_Z)/htot - endif - e(nk_valid(i)+1) = -D_pt(i) - do k=nk_valid(i),1,-1 ; e(K) = e(K+1) + h_f(k,i)*dilate ; enddo - - ! Interpolate each variable into depth space. - k_bot = 1 ; k_bot_prev = -1 - do kz=1,CS%nk_zspace - call find_overlap(e, CS%Z_int(kz), CS%Z_int(kz+1), nk_valid(i), & - k_bot, k_top, k_bot, wt, z1, z2) - if (k_top>nk_valid(i)) exit - !GM if top range that is being map is below the shelf, interpolate - ! otherwise keep missing_vel - if (CS%Z_int(kz)<=-shelf_depth(I)) then - if (linear_velocity_profiles) then - k = k_top - if (k /= k_bot_prev) then - ! Calculate the intra-cell profile. - slope = 0.0 ! ; curv = 0.0 - if ((k < nk_valid(i)) .and. (k > nkml)) call & - find_limited_slope(v_f(:,i), e, slope, k) - endif - ! This is the piecewise linear form. - CS%v_z(i,J,kz) = wt(k) * (v_f(k,i) + 0.5*slope*(z2(k) + z1(k))) - ! For the piecewise parabolic form add the following... - ! + C1_3*curv*(z2(k)**2 + z2(k)*z1(k) + z1(k)**2)) - do k=k_top+1,k_bot-1 - CS%v_z(i,J,kz) = CS%v_z(i,J,kz) + wt(k)*v_f(k,i) - enddo - if (k_bot > k_top) then ; k = k_bot - ! Calculate the intra-cell profile. - slope = 0.0 ! ; curv = 0.0 - if ((k < nk_valid(i)) .and. (k > nkml)) call & - find_limited_slope(v_f(:,i), e, slope, k) - ! This is the piecewise linear form. - CS%v_z(i,J,kz) = CS%v_z(i,J,kz) + wt(k) * & - (v_f(k,i) + 0.5*slope*(z2(k) + z1(k))) - ! For the piecewise parabolic form add the following... - ! + C1_3*curv*(z2(k)**2 + z2(k)*z1(k) + z1(k)**2)) - endif - k_bot_prev = k_bot - else ! Use piecewise constant profiles. - CS%v_z(i,J,kz) = wt(k_top)*v_f(k_top,i) - do k=k_top+1,k_bot - CS%v_z(i,J,kz) = CS%v_z(i,J,kz) + wt(k)*v_f(k,i) - enddo - endif ! linear profiles - endif ! below shelf - enddo ! kz-loop - endif ; enddo ! i-loop and mask - enddo ! J-loop - - call post_data(CS%id_v_z, CS%v_z, CS%diag) - endif - - ! tracer concentrations - if (CS%num_tr_used > 0) then - - do m=1,CS%num_tr_used ; do kz=1,CS%nk_zspace ; do j=js,je ; do i=is,ie - CS%tr_z(m)%p(i,j,kz) = CS%missing_tr(m) - enddo ; enddo ; enddo ; enddo - - do j=js,je - shelf_depth(:) = 0.0 ! initially all is open ocean - ! Remove all massless layers. - do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = G%bathyT(i,j) - if (ice_shelf) then - if (frac_shelf_h(i,j) > 0.) then ! under shelf - shelf_depth(i) = abs(ssh(i,j)) - endif - endif - enddo - do k=1,nk ; do i=is,ie - if ((G%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 2.0*Angstrom)) then - nk_valid(i) = nk_valid(i) + 1 ; k2 = nk_valid(i) - h_f(k2,i) = h(i,j,k) - if (ice_shelf .and. shelf_depth(I) + 1.0E-3*US%m_to_Z > D_pt(i)) nk_valid(I)=0 - do m=1,CS%num_tr_used ; tr_f(k2,m,i) = CS%tr_model(m)%p(i,j,k) ; enddo - endif - enddo ; enddo - - do i=is,ie ; if (nk_valid(i) > 0) then - ! Calculate the z* interface heights for tracers. - htot = 0.0 ; do k=1,nk_valid(i) ; htot = htot + h_f(k,i) ; enddo - dilate = 0.0 - if (htot > 2.0*Angstrom) then - dilate = MAX((D_pt(i) - shelf_depth(i)), GV%Angstrom_Z)/htot - endif - e(nk_valid(i)+1) = -D_pt(i) - do k=nk_valid(i),1,-1 ; e(K) = e(K+1) + h_f(k,i)*dilate ; enddo - - ! Interpolate each variable into depth space. - k_bot = 1 ; k_bot_prev = -1 - do kz=1,CS%nk_zspace - call find_overlap(e, CS%Z_int(kz), CS%Z_int(kz+1), nk_valid(i), & - k_bot, k_top, k_bot, wt, z1, z2) - if (k_top>nk_valid(i)) exit - if (CS%Z_int(kz)<=-shelf_depth(i)) then - do m=1,CS%num_tr_used - k = k_top - if (k /= k_bot_prev) then - ! Calculate the intra-cell profile. - sl_tr(m) = 0.0 ! ; cur_tr(m) = 0.0 - if ((k < nk_valid(i)) .and. (k > nkml)) call & - find_limited_slope(tr_f(:,m,i), e, sl_tr(m), k) - endif - ! This is the piecewise linear form. - CS%tr_z(m)%p(i,j,kz) = wt(k) * & - (tr_f(k,m,i) + 0.5*sl_tr(m)*(z2(k) + z1(k))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr(m)*(z2(k)**2 + z2(k)*z1(k) + z1(k)**2)) - do k=k_top+1,k_bot-1 - CS%tr_z(m)%p(i,j,kz) = CS%tr_z(m)%p(i,j,kz) + wt(k)*tr_f(k,m,i) - enddo - if (k_bot > k_top) then - k = k_bot - ! Calculate the intra-cell profile. - sl_tr(m) = 0.0 ! ; cur_tr(m) = 0.0 - if ((k < nk_valid(i)) .and. (k > nkml)) call & - find_limited_slope(tr_f(:,m,i), e, sl_tr(m), k) - ! This is the piecewise linear form. - CS%tr_z(m)%p(i,j,kz) = CS%tr_z(m)%p(i,j,kz) + wt(k) * & - (tr_f(k,m,i) + 0.5*sl_tr(m)*(z2(k) + z1(k))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr(m)*(z2(k)**2 + z2(k)*z1(k) + z1(k)**2)) - endif - enddo - k_bot_prev = k_bot - endif ! below shelf - enddo ! kz-loop - endif ; enddo ! i-loop and mask - - enddo ! j-loop - - do m=1,CS%num_tr_used - if (CS%id_tr(m) > 0) call post_data(CS%id_tr(m), CS%tr_z(m)%p, CS%diag) - if (CS%id_tr_xyave(m) > 0) then - layer_ave = global_z_mean(CS%tr_z(m)%p, G, GV, US, CS, m) - call post_data(CS%id_tr_xyave(m), layer_ave, CS%diag) - endif - enddo - endif - -end subroutine calculate_Z_diag_fields - -!> This subroutine maps horizontal transport into depth space for diagnostic output. -subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh_int !< Time integrated zonal - !! transport [H m2 ~> m3 or kg]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh_int !< Time integrated meridional - !! transport [H m2 ~> m3 or kg]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, intent(in) :: dt !< The time difference in s since - !! the last call to this - !! subroutine. - type(diag_to_Z_CS), pointer :: CS !< Control structure returned by - !! previous call to - !! diag_to_Z_init. - ! Local variables - real, dimension(SZI_(G), SZJ_(G)) :: & - htot, & ! total layer thickness [H ~> m or kg m-2] - dilate ! Factor by which to dilate layers to convert them - ! into z* space [Z H-1 ~> 1 or m3 kg-1]. (-G%D < z* < 0) - - real, dimension(SZI_(G), max(CS%nk_zspace,1)) :: & - uh_Z ! uh_int interpolated into depth space [H m2 ~> m3 or kg] - real, dimension(SZIB_(G), max(CS%nk_zspace,1)) :: & - vh_Z ! vh_int interpolated into depth space [H m2 ~> m3 or kg] - - real :: h_rem ! dilated thickness of a layer that has yet to be mapped - ! into depth space [Z ~> m] - real :: uh_rem ! integrated zonal transport of a layer that has yet to be - ! mapped into depth space [H m2 ~> m3 or kg] - real :: vh_rem ! integrated meridional transport of a layer that has yet - ! to be mapped into depth space [H m2 ~> m3 or kg] - real :: h_here ! thickness of a layer that is within the range of the - ! current depth level [Z ~> m] - real :: h_above ! thickness of a layer that is above the current depth - ! level [Z ~> m] - real :: uh_here ! zonal transport of a layer that is attributed to the - ! current depth level [H m2 ~> m3 or kg] - real :: vh_here ! meridional transport of a layer that is attributed to - ! the current depth level [H m2 ~> m3 or kg] - real :: Idt ! inverse of the time step [s] - - real :: z_int_above(SZIB_(G)) ! height of the interface atop a layer [H ~> m or kg m-2] - - integer :: kz(SZIB_(G)) ! index of depth level that is being contributed to - - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nk, nk_z - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nk = G%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - - if (.not.associated(CS)) call MOM_error(FATAL, & - "calculate_Z_transport: Module must be initialized before it is used.") - if ((CS%id_uh_Z <= 0) .and. (CS%id_vh_Z <= 0)) return - - Idt = 1.0 ; if (dt > 0.0) Idt = 1.0 / dt - nk_z = CS%nk_zspace - - if (nk_z <= 0) return - - ! Determine how much the layers will be dilated in recasting them into z* - ! coordiantes. (-G%D < z* < 0). - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - htot(i,j) = GV%H_subroundoff - enddo ; enddo - do k=1,nk ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - htot(i,j) = htot(i,j) + h(i,j,k) - enddo ; enddo ; enddo - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dilate(i,j) = G%bathyT(i,j) / htot(i,j) - enddo ; enddo - - ! zonal transport - if (CS%id_uh_Z > 0) then ; do j=js,je - do I=Isq,Ieq - kz(I) = nk_z ; z_int_above(I) = -0.5*(G%bathyT(i,j)+G%bathyT(i+1,j)) - enddo - do k=nk_z,1,-1 ; do I=Isq,Ieq - uh_Z(I,k) = 0.0 - if (CS%Z_int(k) < z_int_above(I)) kz(I) = k-1 - enddo ; enddo - do k=nk,1,-1 ; do I=Isq,Ieq - h_rem = 0.5*(dilate(i,j)*h(i,j,k) + dilate(i+1,j)*h(i+1,j,k)) - uh_rem = uh_int(I,j,k) - z_int_above(I) = z_int_above(I) + h_rem - - do ! Distribute this layer's transport into the depth-levels. - h_above = z_int_above(I) - CS%Z_int(kz(I)) - if ((kz(I) == 1) .or. (h_above <= 0.0) .or. (h_rem <= 0.0)) then - ! The entire remaining transport is on this level. - uh_Z(I,kz(I)) = uh_Z(I,kz(I)) + uh_rem ; exit - else - h_here = h_rem - h_above - uh_here = uh_rem * (h_here / h_rem) - - h_rem = h_rem - h_here ! = h_above - uh_Z(I,kz(I)) = uh_Z(I,kz(I)) + uh_here - uh_rem = uh_rem - uh_here - kz(I) = kz(I) - 1 - endif - enddo ! End of loop through the target depth-space levels. - enddo ; enddo - do k=1,nk_z ; do I=Isq,Ieq - CS%uh_z(I,j,k) = uh_Z(I,k)*Idt - enddo ; enddo - enddo ; endif - - ! meridional transport - if (CS%id_vh_Z > 0) then ; do J=Jsq,Jeq - do i=is,ie - kz(i) = nk_z ; z_int_above(i) = -0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) - enddo - do k=nk_z,1,-1 ; do i=is,ie - vh_Z(i,k) = 0.0 - if (CS%Z_int(k) < z_int_above(i)) kz(i) = k-1 - enddo ; enddo - do k=nk,1,-1 ; do i=is,ie - h_rem = 0.5*(dilate(i,j)*h(i,j,k) + dilate(i,j+1)*h(i,j+1,k)) - vh_rem = vh_int(i,J,k) - z_int_above(i) = z_int_above(i) + h_rem - - do ! Distribute this layer's transport into the depth-levels. - h_above = z_int_above(i) - CS%Z_int(kz(i)) - if ((kz(i) == 1) .or. (h_above <= 0.0) .or. (h_rem <= 0.0)) then - ! The entire remaining transport is on this level. - vh_Z(i,kz(i)) = vh_Z(i,kz(i)) + vh_rem ; exit - else - h_here = h_rem - h_above - vh_here = vh_rem * (h_here / h_rem) - - h_rem = h_rem - h_here ! = h_above - vh_Z(i,kz(i)) = vh_Z(i,kz(i)) + vh_here - vh_rem = vh_rem - vh_here - kz(i) = kz(i) - 1 - endif - enddo ! End of loop through the target depth-space levels. - enddo ; enddo - do k=1,nk_z ; do i=is,ie - CS%vh_z(i,J,k) = vh_Z(i,k)*Idt - enddo ; enddo - enddo ; endif - - if (CS%id_uh_Z > 0) then - do k=1,nk_z ; do j=js,je ; do I=Isq,Ieq - CS%uh_z(i,j,k) = CS%uh_z(i,j,k)*GV%H_to_kg_m2 - enddo ; enddo ; enddo - call post_data(CS%id_uh_Z, CS%uh_z, CS%diag) - endif - - if (CS%id_vh_Z > 0) then - do k=1,nk_z ; do j=Jsq,Jeq ; do I=is,ie - CS%vh_z(i,j,k) = CS%vh_z(i,j,k)*GV%H_to_kg_m2 - enddo ; enddo ; enddo - call post_data(CS%id_vh_Z, CS%vh_z, CS%diag) - endif - -end subroutine calculate_Z_transport - -!> Determines the layers bounded by interfaces e that overlap -!! with the depth range between Z_top and Z_bot, and the fractional weights -!! of each layer. It also calculates the normalized relative depths of the range -!! of each layer that overlaps that depth range. -subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e !< Column interface heights, in arbitrary units. - real, intent(in) :: Z_top !< Top of range being mapped to, in the units of e. - real, intent(in) :: Z_bot !< Bottom of range being mapped to, in the units of e. - integer, intent(in) :: k_max !< Number of valid layers. - integer, intent(in) :: k_start !< Layer at which to start searching. - integer, intent(inout) :: k_top !< Indices of top layers that overlap with the depth - !! range. - integer, intent(inout) :: k_bot !< Indices of bottom layers that overlap with the - !! depth range. - real, dimension(:), intent(out) :: wt !< Relative weights of each layer from k_top to k_bot. - real, dimension(:), intent(out) :: z1 !< Depth of the top limits of the part of - !! a layer that contributes to a depth level, relative to the cell center and normalized - !! by the cell thickness [nondim]. Note that -1/2 <= z1 < z2 <= 1/2. - real, dimension(:), intent(out) :: z2 !< Depths of the bottom limit of the part of - !! a layer that contributes to a depth level, relative to the cell center and normalized - !! by the cell thickness [nondim]. Note that -1/2 <= z1 < z2 <= 1/2. - ! Local variables - real :: Ih, e_c, tot_wt, I_totwt - integer :: k - - do k=k_start,k_max ; if (e(K+1)k_max) return - - ! Determine the fractional weights of each layer. - ! Note that by convention, e and Z_int decrease with increasing k. - if (e(K+1)<=Z_bot) then - wt(k) = 1.0 ; k_bot = k - Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) - e_c = 0.5*(e(K)+e(K+1)) - z1(k) = (e_c - MIN(e(K),Z_top)) * Ih - z2(k) = (e_c - Z_bot) * Ih - else - wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. - if (e(K) /= e(K+1)) then - z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) - else ; z1(k) = -0.5 ; endif - z2(k) = 0.5 - k_bot = k_max - do k=k_top+1,k_max - if (e(K+1)<=Z_bot) then - k_bot = k - wt(k) = e(K) - Z_bot ; z1(k) = -0.5 - if (e(K) /= e(K+1)) then - z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) - else ; z2(k) = 0.5 ; endif - else - wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 - endif - tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. - if (k>=k_bot) exit - enddo - - I_totwt = 1.0 / tot_wt - do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo - endif - -end subroutine find_overlap - -!> This subroutine determines a limited slope for val to be advected with -!! a piecewise limited scheme. -subroutine find_limited_slope(val, e, slope, k) - real, dimension(:), intent(in) :: val !< A column of values that are being interpolated. - real, dimension(:), intent(in) :: e !< Column interface heights in arbitrary units - real, intent(out) :: slope !< Normalized slope in the intracell distribution of val. - integer, intent(in) :: k !< Layer whose slope is being determined. - ! Local variables - real :: d1, d2 ! Thicknesses in the units of e. - - d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) - if (((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) .or. (d1*d2 <= 0.0)) then - slope = 0.0 ! ; curvature = 0.0 - else - slope = (d1**2*(val(k+1) - val(k)) + d2**2*(val(k) - val(k-1))) * & - ((e(K) - e(K+1)) / (d1*d2*(d1+d2))) - ! slope = 0.5*(val(k+1) - val(k-1)) - ! This is S.J. Lin's form of the PLM limiter. - slope = sign(1.0,slope) * min(abs(slope), & - 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & - 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) - ! curvature = 0.0 - endif - -end subroutine find_limited_slope - -!> This subroutine calculates interface diagnostics in z-space. -subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(p3d), dimension(:), intent(in) :: in_ptrs !< Pointers to the diagnostics to be regridded - integer, dimension(:), intent(in) :: ids !< The diagnostic IDs of the diagnostics - integer, intent(in) :: num_diags !< The number of diagnostics to regrid - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(diag_to_Z_CS), pointer :: CS !< Control structure returned by - !! previous call to diag_to_Z_init. - ! Local variables - real, dimension(SZI_(G),SZJ_(G),max(CS%nk_zspace+1,1),max(num_diags,1)) :: & - diag_on_Z ! diagnostics interpolated to depth space - real, dimension(SZI_(G),SZK_(G)+1) :: e - real, dimension(max(num_diags,1),SZI_(G),SZK_(G)+1) :: diag2d - - real, dimension(SZI_(G)) :: & - htot, & ! summed layer thicknesses [H ~> m or kg m-2] - dilate ! proportion by which to dilate every layer - real :: wt ! weighting of the interface above in the - ! interpolation to target depths - integer :: kL(SZI_(G)) ! layer-space index of shallowest interface - ! below the target depth - - integer :: i, j, k, k2, kz, is, ie, js, je, nk, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nk = G%ke - - if (num_diags < 1) return - if (.not.associated(CS)) call MOM_error(FATAL, & - "calc_Zint_diags: Module must be initialized before it is used.") - - do j=js,je - ! Calculate the stretched z* interface depths. - do i=is,ie ; htot(i) = 0.0 ; kL(i) = 1 ; enddo - do k=1,nk ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo - do i=is,ie - dilate(i) = 0.0 - if (htot(i) > 0.5*GV%m_to_H) dilate(i) = (G%bathyT(i,j) - 0.0) / htot(i) - e(i,nk+1) = -G%bathyT(i,j) - enddo - do k=nk,1,-1 ; do i=is,ie - e(i,k) = e(i,k+1) + h(i,j,k) * dilate(i) - enddo ; enddo - ! e(i,1) should be 0 as a consistency check. - - do k=1,nk+1 ; do i=is,ie ; do m=1,num_diags - diag2d(m,i,k) = in_ptrs(m)%p(i,j,k) - enddo ; enddo ; enddo - - do kz=1,CS%nk_zspace+1 ; do i=is,ie - ! Find the interface below the target Z-file depth, kL. - if (CS%Z_int(kz) < e(i,nk+1)) then - kL(i) = nk+2 - else - do k=kL(i),nk+1 ; if (CS%Z_int(kz) > e(i,k)) exit ; enddo - kL(i) = k - endif - if (kL(i)>1) then - if (CS%Z_int(kz) > e(i,kL(i)-1)) call MOM_error(FATAL, & - "calc_Zint_diags: Interface depth mapping is incorrect.") - endif - if ((kL(i)>1) .and. (kL(i)<=nk+1)) then - if (e(i,kL(i)-1) == e(i,kL(i))) call MOM_error(WARNING, & - "calc_Zint_diags: Interface depths equal.", all_print=.true.) - if (e(i,kL(i)-1) - e(i,kL(i)) < 0.0) call MOM_error(FATAL, & - "calc_Zint_diags: Interface depths inverted.") - endif - - if (kL(i) <= 1) then - do m=1,num_diags - diag_on_Z(i,j,kz,m) = diag2d(m,i,1) - enddo - elseif (kL(i) > nk+1) then - do m=1,num_diags - diag_on_Z(i,j,kz,m) = CS%missing_value - enddo - else - wt = 0.0 ! This probably should not happen? - if (e(i,kL(i)-1) - e(i,kL(i)) > 0.0) & - wt = (CS%Z_int(kz) - e(i,kL(i))) / (e(i,kL(i)-1) - e(i,kL(i))) - if ((wt < 0.0) .or. (wt > 1.0)) call MOM_error(FATAL, & - "calc_Zint_diags: Bad value of wt found.") - do m=1,num_diags - diag_on_Z(i,j,kz,m) = wt * diag2d(m,i,kL(i)-1) + & - (1.0-wt) * diag2d(m,i,kL(i)) - enddo - endif - enddo ; enddo - - enddo - - do m=1,num_diags - if (ids(m) > 0) call post_data(ids(m), diag_on_Z(:,:,:,m), CS%diag) - enddo - -end subroutine calc_Zint_diags - -!> This subroutine registers a tracer to be output in depth space. -subroutine register_Z_tracer(tr_ptr, name, long_name, units, Time, G, CS, standard_name, & - cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - target, intent(in) :: tr_ptr !< Tracer for translation to Z-space. - character(len=*), intent(in) :: name !< name for the output tracer. - character(len=*), intent(in) :: long_name !< Long name for the output tracer. - character(len=*), intent(in) :: units !< Units of output tracer. - character(len=*), optional, intent(in) :: standard_name !< The CMOR standard name of this variable. - type(time_type), intent(in) :: Time !< Current model time. - type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous - !! call to diag_to_Z_init. - character(len=*), optional, intent(in) :: cmor_field_name !< cmor name of a field. - character(len=*), optional, intent(in) :: cmor_long_name !< cmor long name of a field. - character(len=*), optional, intent(in) :: cmor_units !< cmor units of a field. - character(len=*), optional, intent(in) :: cmor_standard_name !< cmor standardized name - !! associated with a field. - - ! Local variables - character(len=256) :: posted_standard_name - character(len=256) :: posted_cmor_units - character(len=256) :: posted_cmor_standard_name - character(len=256) :: posted_cmor_long_name - - if (CS%nk_zspace<1) return - - if (present(standard_name)) then - posted_standard_name = standard_name - else - posted_standard_name = 'not provided' - endif - - call register_Z_tracer_low(tr_ptr, name, long_name, units, trim(posted_standard_name), Time, G, CS) - - if (present(cmor_field_name)) then - ! Fallback values for strings set to "NULL" - posted_cmor_units = "not provided" ! - posted_cmor_standard_name = "not provided" ! values might be replaced with a CS%missing field? - posted_cmor_long_name = "not provided" ! - - ! If attributes are present for MOM variable names, use them first for the register_diag_field - ! call for CMOR verison of the variable - posted_cmor_units = units - posted_cmor_long_name = long_name - posted_cmor_standard_name = posted_standard_name - - ! If specified in the call to register_diag_field, override attributes with the CMOR versions - if (present(cmor_units)) posted_cmor_units = cmor_units - if (present(cmor_standard_name)) posted_cmor_standard_name = cmor_standard_name - if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name - - call register_Z_tracer_low(tr_ptr, trim(cmor_field_name), trim(posted_cmor_long_name),& - trim(posted_cmor_units), trim(posted_cmor_standard_name), Time, G, CS) - - endif - -end subroutine register_Z_tracer - -!> This subroutine registers a tracer to be output in depth space. -subroutine register_Z_tracer_low(tr_ptr, name, long_name, units, standard_name, Time, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - target, intent(in) :: tr_ptr !< Tracer for translation to Z-space. - character(len=*), intent(in) :: name !< Name for the output tracer. - character(len=*), intent(in) :: long_name !< Long name for output tracer. - character(len=*), intent(in) :: units !< Units of output tracer. - character(len=*), intent(in) :: standard_name !< The CMOR standard name of this variable. - type(time_type), intent(in) :: Time !< Current model time. - type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous call to - !! diag_to_Z_init. - ! Local variables - character(len=256) :: posted_standard_name - integer :: isd, ied, jsd, jed, nk, m, id_test - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nk = G%ke - - if (.not.associated(CS)) call MOM_error(FATAL, & - "register_Z_tracer: Module must be initialized before it is used.") - - if (CS%num_tr_used >= MAX_FIELDS_) then - call MOM_error(WARNING,"MOM_diag_to_Z: Attempted to register and use "//& - "more than MAX_FIELDS_ z-space tracers via register_Z_tracer.") - return - endif - - m = CS%num_tr_used + 1 - - CS%missing_tr(m) = CS%missing_value ! This could be changed later, if desired. - if (CS%nk_zspace > 0) then - CS%id_tr(m) = register_diag_field('ocean_model_zold', name, CS%axesTz, Time, & - long_name, units, missing_value=CS%missing_tr(m), & - standard_name=standard_name) - CS%id_tr_xyave(m) = register_diag_field('ocean_model_zold', trim(name)//'_xyave', CS%axesZ, Time, & - long_name, units, missing_value=CS%missing_tr(m), & - standard_name=standard_name) - else - id_test = register_diag_field('ocean_model_zold', name, CS%diag%axesT1, Time, & - long_name, units, missing_value=CS%missing_tr(m), & - standard_name=standard_name) - if (id_test>0) call MOM_error(WARNING, & - "MOM_diag_to_Z_init: "//trim(name)// & - " cannot be output without an appropriate depth-space target file.") - endif - - if (CS%id_tr(m) <= 0) CS%id_tr(m) = -1 - if (CS%id_tr_xyave(m) <= 0) CS%id_tr_xyave(m) = -1 - if (CS%id_tr(m) > 0 .or. CS%id_tr_xyave(m) > 0) then - CS%num_tr_used = m - call safe_alloc_ptr(CS%tr_z(m)%p,isd,ied,jsd,jed,CS%nk_zspace) - CS%tr_model(m)%p => tr_ptr - endif - -end subroutine register_Z_tracer_low - -!> This subroutine sets parameters that control Z-space diagnostic output. -subroutine MOM_diag_to_Z_init(Time, G, GV, US, param_file, diag, CS) - type(time_type), intent(in) :: Time !< Current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(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 !< Struct to regulate diagnostic output. - type(diag_to_Z_CS), pointer :: CS !< Pointer to point to control structure for - !! this module, which is allocated and - !! populated here. -! This include declares and sets the variable "version". -#include "version_variable.h" - ! Local variables - character(len=40) :: mdl = "MOM_diag_to_Z" ! module name - character(len=200) :: in_dir, zgrid_file ! strings for directory/file - character(len=48) :: flux_units, string - integer :: z_axis, zint_axis - integer :: k, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nk, id_test - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nk = G%ke - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - - if (associated(CS)) then - call MOM_error(WARNING, "MOM_diag_to_Z_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - - if (GV%Boussinesq) then ; flux_units = "m3 s-1" - else ; flux_units = "kg s-1" ; endif - - CS%diag => diag - - ! Read parameters and write them to the model log. - call log_version(param_file, mdl, version, "") - ! Read in z-space info from a NetCDF file. - call get_param(param_file, mdl, "Z_OUTPUT_GRID_FILE", zgrid_file, & - "The file that specifies the vertical grid for \n"//& - "depth-space diagnostics, or blank to disable \n"//& - "depth-space output.", default="") - - if (len_trim(zgrid_file) > 0) then - call get_param(param_file, mdl, "INPUTDIR", in_dir, & - "The directory in which input files are found.", default=".") - in_dir = slasher(in_dir) - call get_Z_depths(trim(in_dir)//trim(zgrid_file), "zw", CS%Z_int, "zt", & - z_axis, zint_axis, CS%nk_zspace) - do K=1,CS%nk_zspace+1 ; CS%Z_int(K) = US%m_to_Z*CS%Z_int(K) ; enddo - call log_param(param_file, mdl, "!INPUTDIR/Z_OUTPUT_GRID_FILE", & - trim(in_dir)//trim(zgrid_file)) - call log_param(param_file, mdl, "!NK_ZSPACE (from file)", CS%nk_zspace, & - "The number of depth-space levels. This is determined \n"//& - "from the size of the variable zw in the output grid file.", & - units="nondim") - else - CS%nk_zspace = -1 - endif - - if (CS%nk_zspace > 0) then - - call define_axes_group(diag, (/ diag%axesB1%handles(1), diag%axesB1%handles(2), z_axis /), CS%axesBz) - call define_axes_group(diag, (/ diag%axesT1%handles(1), diag%axesT1%handles(2), z_axis /), CS%axesTz) - call define_axes_group(diag, (/ diag%axesCu1%handles(1), diag%axesCu1%handles(2), z_axis /), CS%axesCuz) - call define_axes_group(diag, (/ diag%axesCv1%handles(1), diag%axesCv1%handles(2), z_axis /), CS%axesCvz) - call define_axes_group(diag, (/ diag%axesB1%handles(1), diag%axesB1%handles(2), zint_axis /), CS%axesBzi) - call define_axes_group(diag, (/ diag%axesT1%handles(1), diag%axesT1%handles(2), zint_axis /), CS%axesTzi) - call define_axes_group(diag, (/ diag%axesCu1%handles(1), diag%axesCu1%handles(2), zint_axis /), CS%axesCuzi) - call define_axes_group(diag, (/ diag%axesCv1%handles(1), diag%axesCv1%handles(2), zint_axis /), CS%axesCvzi) - call define_axes_group(diag, (/ z_axis /), CS%axesZ) - - CS%id_u_z = register_diag_field('ocean_model_zold', 'u', CS%axesCuz, Time, & - 'Zonal Velocity in Depth Space', 'm s-1', & - missing_value=CS%missing_vel, cmor_field_name='uo', cmor_units='m s-1',& - cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') - if (CS%id_u_z>0) call safe_alloc_ptr(CS%u_z,IsdB,IedB,jsd,jed,CS%nk_zspace) - - CS%id_v_z = register_diag_field('ocean_model_zold', 'v', CS%axesCvz, Time, & - 'Meridional Velocity in Depth Space', 'm s-1', & - missing_value=CS%missing_vel, cmor_field_name='vo', cmor_units='m s-1',& - cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') - if (CS%id_v_z>0) call safe_alloc_ptr(CS%v_z,isd,ied,JsdB,JedB,CS%nk_zspace) - - CS%id_uh_z = register_diag_field('ocean_model_zold', 'uh', CS%axesCuz, Time, & - 'Zonal Mass Transport (including SGS param) in Depth Space', flux_units, & - missing_value=CS%missing_trans) - if (CS%id_uh_z>0) call safe_alloc_ptr(CS%uh_z,IsdB,IedB,jsd,jed,CS%nk_zspace) - - CS%id_vh_z = register_diag_field('ocean_model_zold', 'vh', CS%axesCvz, Time, & - 'Meridional Mass Transport (including SGS param) in Depth Space', flux_units,& - missing_value=CS%missing_trans) - if (CS%id_vh_z>0) call safe_alloc_ptr(CS%vh_z,isd,ied,JsdB,JedB,CS%nk_zspace) - - endif - -end subroutine MOM_diag_to_Z_init - -!> This subroutine reads the depths of the interfaces bounding the intended -!! layers from a NetCDF file. If no appropriate file is found, -1 is returned -!! as the number of layers in the output file. Also, a diag_manager axis is set -!! up with the same information as this axis. -subroutine get_Z_depths(depth_file, int_depth_name, int_depth, cell_depth_name, & - z_axis_index, edge_index, nk_out) - character(len=*), intent(in) :: depth_file !< The file to read for the depths - character(len=*), intent(in) :: int_depth_name !< The interface depth variable name - real, dimension(:), pointer :: int_depth !< A pointer that will be allocated and - !! returned with the interface depths in m - character(len=*), intent(in) :: cell_depth_name !< The cell-center depth variable name - integer, intent(out) :: z_axis_index !< The cell-center z-axis diagnostic index handle - integer, intent(out) :: edge_index !< The interface z-axis diagnostic index handle - integer, intent(out) :: nk_out !< The number of layers in the output grid - ! Local variables - real, allocatable :: cell_depth(:) - character (len=200) :: units, long_name - integer :: ncid, status, intid, intvid, layid, layvid, k, ni - - nk_out = -1 - - status = NF90_OPEN(depth_file, NF90_NOWRITE, ncid) - if (status /= NF90_NOERR) then - call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - " Difficulties opening "//trim(depth_file)//" - "//& - trim(NF90_STRERROR(status))) - nk_out = -1 ; return - endif - - status = NF90_INQ_DIMID(ncid, int_depth_name, intid) - if (status /= NF90_NOERR) then - call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Getting ID of dimension "//& - trim(int_depth_name)//" in "//trim(depth_file)) - nk_out = -1 ; return - endif - - status = nf90_Inquire_Dimension(ncid, intid, len=ni) - if (status /= NF90_NOERR) then - call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Getting number of interfaces of "//& - trim(int_depth_name)//" in "//trim(depth_file)) - nk_out = -1 ; return - endif - - if (ni < 2) then - call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - "At least two interface depths must be specified in "//trim(depth_file)) - nk_out = -1 ; return - endif - - status = NF90_INQ_DIMID(ncid, cell_depth_name, layid) - if (status /= NF90_NOERR) call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Getting ID of dimension "//& - trim(cell_depth_name)//" in "//trim(depth_file)) - - status = nf90_Inquire_Dimension(ncid, layid, len=nk_out) - if (status /= NF90_NOERR) call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Getting number of interfaces of "//& - trim(cell_depth_name)//" in "//trim(depth_file)) - - if (ni /= nk_out+1) then - call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - "The interface depths must have one more point than cell centers in "//& - trim(depth_file)) - nk_out = -1 ; return - endif - - allocate(int_depth(nk_out+1)) - allocate(cell_depth(nk_out)) - - status = NF90_INQ_VARID(ncid, int_depth_name, intvid) - if (status /= NF90_NOERR) call MOM_error(FATAL,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Getting ID of variable "//& - trim(int_depth_name)//" in "//trim(depth_file)) - status = NF90_GET_VAR(ncid, intvid, int_depth) - if (status /= NF90_NOERR) call MOM_error(FATAL,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Reading variable "//& - trim(int_depth_name)//" in "//trim(depth_file)) - status = NF90_GET_ATT(ncid, intvid, "units", units) - if (status /= NF90_NOERR) units = "m" - status = NF90_GET_ATT(ncid, intvid, "long_name", long_name) - if (status /= NF90_NOERR) long_name = "Depth of edges" - edge_index = diag_axis_init(int_depth_name, int_depth, units, 'z', & - long_name, direction=-1) - -! Create an fms axis with the same data as the cell_depth array in the input file. - status = NF90_INQ_VARID(ncid, cell_depth_name, layvid) - if (status /= NF90_NOERR) call MOM_error(FATAL,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Getting ID of variable "//& - trim(cell_depth_name)//" in "//trim(depth_file)) - status = NF90_GET_VAR(ncid, layvid, cell_depth) - if (status /= NF90_NOERR) call MOM_error(FATAL,"MOM_diag_to_Z get_Z_depths: "//& - trim(NF90_STRERROR(status))//" Reading variable "//& - trim(cell_depth_name)//" in "//trim(depth_file)) - status = NF90_GET_ATT(ncid, layvid, "units", units) - if (status /= NF90_NOERR) units = "m" - status = NF90_GET_ATT(ncid, layvid, "long_name", long_name) - if (status /= NF90_NOERR) long_name = "Depth of cell center" - - z_axis_index = diag_axis_init(cell_depth_name, cell_depth, units, 'z',& - long_name, edges = edge_index, direction=-1) - - deallocate(cell_depth) - - status = nf90_close(ncid) - - ! Check the sign convention and change to the MOM "height" convention. - if (int_depth(1) < int_depth(2)) then - do k=1,nk_out+1 ; int_depth(k) = -1*int_depth(k) ; enddo - endif - - ! Check for inversions in grid. - do k=1,nk_out ; if (int_depth(k) < int_depth(k+1)) then - call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& - "Inverted interface depths in output grid in "//depth_file) - nk_out = -1 ; deallocate(int_depth) ; return - endif ; enddo - -end subroutine get_Z_depths - -!> Deallocate memory associated with the MOM_diag_to_Z module -subroutine MOM_diag_to_Z_end(CS) - type(diag_to_Z_CS), pointer :: CS !< Control structure returned by a previous call to diag_to_Z_init. - integer :: m - - if (associated(CS%u_z)) deallocate(CS%u_z) - if (associated(CS%v_z)) deallocate(CS%v_z) - if (associated(CS%Z_int)) deallocate(CS%Z_int) - do m=1,CS%num_tr_used ; deallocate(CS%tr_z(m)%p) ; enddo - - deallocate(CS) - -end subroutine MOM_diag_to_Z_end - -!> This subroutine registers a tracer to be output in depth space. -function ocean_register_diag_with_z(tr_ptr, vardesc_tr, G, Time, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - target, intent(in) :: tr_ptr !< Tracer for translation to Z-space. - type(vardesc), intent(in) :: vardesc_tr !< Variable descriptor. - type(time_type), intent(in) :: Time !< Current model time. - type(diag_to_Z_CS), pointer :: CS !< Control struct returned by a previous - !! call to diag_to_Z_init. - integer :: ocean_register_diag_with_z !< The retuned Z-space diagnostic ID - ! Local variables - type(vardesc) :: vardesc_z - character(len=64) :: var_name ! A variable's name. - integer :: isd, ied, jsd, jed, nk, m, id_test - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nk = G%ke - if (.not.associated(CS)) call MOM_error(FATAL, & - "register_Z_tracer: Module must be initialized before it is used.") - if (CS%nk_zspace<1) return - - if (CS%num_tr_used >= MAX_FIELDS_) then - call MOM_error(WARNING,"ocean_register_diag_with_z: Attempted to register and use "//& - "more than MAX_FIELDS_ z-space tracers via ocean_register_diag_with_z.") - return - endif - - ! register the layer tracer - ocean_register_diag_with_z = ocean_register_diag(vardesc_tr, G, CS%diag, Time) - - ! copy layer tracer variable descriptor to a z-tracer descriptor - ! change the name and layer information. - vardesc_z = vardesc_tr - call modify_vardesc(vardesc_z, z_grid="z", caller="ocean_register_diag_with_z") - m = CS%num_tr_used + 1 - CS%missing_tr(m) = CS%missing_value ! This could be changed later, if desired. - CS%id_tr(m) = register_Z_diag(vardesc_z, CS, Time, CS%missing_tr(m)) - - if (CS%nk_zspace > NO_ZSPACE) then -! There is a depth-space target file. - if (CS%id_tr(m)>0) then -! Only allocate the tr_z field id there is a diag_table entry looking -! for it. - CS%num_tr_used = m - call safe_alloc_ptr(CS%tr_z(m)%p,isd,ied,jsd,jed,CS%nk_zspace) -!Can we do the following at this point? -! tr_ptr might not be allocated yet - CS%tr_model(m)%p => tr_ptr - endif - else -! There is no depth-space target file but warn if a diag_table entry is -! present. - call query_vardesc(vardesc_z, name=var_name, caller="ocean_register_diag_with_z") - if (CS%id_tr(m)>0) call MOM_error(WARNING, & - "ocean_register_diag_with_z: "//trim(var_name)// & - " cannot be output without an appropriate depth-space target file.") - endif - -end function ocean_register_diag_with_z - -!> Register a diagnostic to be output in depth space. -function register_Z_diag(var_desc, CS, day, missing) - integer :: register_Z_diag !< The returned z-layer diagnostic index - type(vardesc), intent(in) :: var_desc !< A type with metadata for this diagnostic - type(diag_to_Z_CS), pointer :: CS !< Control structure returned by - !! previous call to diag_to_Z_init. - type(time_type), intent(in) :: day !< The current model time - real, intent(in) :: missing !< The missing value for this diagnostic - ! Local variables - character(len=64) :: var_name ! A variable's name. - character(len=48) :: units ! A variable's units. - character(len=240) :: longname ! A variable's longname. - character(len=8) :: hor_grid, z_grid ! Variable grid info. - type(axes_grp), pointer :: axes => NULL() - - call query_vardesc(var_desc, name=var_name, units=units, longname=longname, & - hor_grid=hor_grid, z_grid=z_grid, caller="register_Zint_diag") - - ! Use the hor_grid and z_grid components of vardesc to determine the - ! desired axes to register the diagnostic field for. - select case (z_grid) - - case ("z") - select case (hor_grid) - case ("q") - axes => CS%axesBz - case ("h") - axes => CS%axesTz - case ("u") - axes => CS%axesCuz - case ("v") - axes => CS%axesCvz - case ("Bu") - axes => CS%axesBz - case ("T") - axes => CS%axesTz - case ("Cu") - axes => CS%axesCuz - case ("Cv") - axes => CS%axesCvz - case default - call MOM_error(FATAL,& - "register_Z_diag: unknown hor_grid component "//trim(hor_grid)) - end select - - case default - call MOM_error(FATAL,& - "register_Z_diag: unknown z_grid component "//trim(z_grid)) - end select - - register_Z_diag = register_diag_field("ocean_model_zold", trim(var_name), axes, & - day, trim(longname), trim(units), missing_value=missing) - -end function register_Z_diag - -!> Register a diagnostic to be output at depth space interfaces -function register_Zint_diag(var_desc, CS, day, conversion) - integer :: register_Zint_diag !< The returned z-interface diagnostic index - type(vardesc), intent(in) :: var_desc !< A type with metadata for this diagnostic - type(diag_to_Z_CS), pointer :: CS !< Control structure returned by - !! previous call to diag_to_Z_init. - type(time_type), intent(in) :: day !< The current model time - real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - ! Local variables - character(len=64) :: var_name ! A variable's name. - character(len=48) :: units ! A variable's units. - character(len=240) :: longname ! A variable's longname. - character(len=8) :: hor_grid ! Variable grid info. - type(axes_grp), pointer :: axes => NULL() - - call query_vardesc(var_desc, name=var_name, units=units, longname=longname, & - hor_grid=hor_grid, caller="register_Zint_diag") - - if (CS%nk_zspace < 0) then - register_Zint_diag = -1 ; return - endif - - ! Use the hor_grid and z_grid components of vardesc to determine the - ! desired axes to register the diagnostic field for. - select case (hor_grid) - case ("h") - axes => CS%axesTzi - case ("q") - axes => CS%axesBzi - case ("u") - axes => CS%axesCuzi - case ("v") - axes => CS%axesCvzi - case default - call MOM_error(FATAL,& - "register_Z_diag: unknown hor_grid component "//trim(hor_grid)) - end select - - register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name), & - axes, day, trim(longname), trim(units), missing_value=CS%missing_value, & - conversion=conversion) - -end function register_Zint_diag - -end module MOM_diag_to_Z diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 767625f1ea..d0f17238cf 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -13,7 +13,6 @@ module MOM_diagnostics use MOM_diag_mediator, only : diag_get_volume_cell_measure_dm_id use MOM_diag_mediator, only : diag_grid_storage use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids, diag_copy_storage_to_diag -use MOM_diag_to_Z, only : calculate_Z_transport, diag_to_Z_CS use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : To_North, To_East use MOM_EOS, only : calculate_density, int_density_dz @@ -1313,8 +1312,8 @@ end subroutine post_surface_thermo_diags !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, & - diag_to_Z_CSp, Reg) +subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & + diag, dt_trans, Reg) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes @@ -1327,8 +1326,6 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d type(diag_grid_storage), intent(inout) :: diag_pre_dyn !< Stored grids from before dynamics type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output real, intent(in) :: dt_trans !< total time step associated with the transports [s]. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A control structure for remapping - !! the transports to depth space type(tracer_registry_type), pointer :: Reg !< Pointer to the tracer registry ! Local variables @@ -1347,8 +1344,6 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d Idt = 1. / dt_trans H_to_kg_m2_dt = GV%H_to_kg_m2 * Idt - call calculate_Z_transport(uhtr, vhtr, h, dt_trans, G, GV, diag_to_Z_CSp) - call diag_save_grids(diag) call diag_copy_storage_to_diag(diag, diag_pre_dyn) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 7c1ee90f12..3ae1b70c14 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -201,6 +201,8 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") + call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") + ! Write the file version number to the model log. call log_version(param_file, mdl, version) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 133d1c8645..e29ead8e2b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -20,7 +20,6 @@ module MOM_diabatic_driver use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end use MOM_diag_mediator, only : diag_copy_diag_to_storage, diag_copy_storage_to_diag use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids -use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags 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 @@ -43,7 +42,6 @@ module MOM_diabatic_driver use MOM_forcing_type, only : calculateBuoyancyFlux2d, forcing_SinglePointPrint use MOM_geothermal, only : geothermal, geothermal_init, geothermal_end, geothermal_CS use MOM_grid, only : ocean_grid_type -use MOM_io, only : vardesc, var_desc use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type use MOM_interface_heights, only : find_eta @@ -183,9 +181,8 @@ module MOM_diabatic_driver integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM) integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic integer :: id_dudt_dia = -1, id_dvdt_dia = -1, id_ea_s = -1, id_eb_s = -1 - integer :: id_ea_t = -1, id_eb_t = -1, id_Kd_z = -1 + integer :: id_ea_t = -1, id_eb_t = -1 integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 - integer :: id_Tdif_z = -1, id_Tadv_z = -1, id_Sdif_z = -1, id_Sadv_z = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 integer :: id_subMLN2 = -1, id_brine_lay = -1 @@ -238,7 +235,6 @@ module MOM_diabatic_driver type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module 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(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< Control structure for a child module type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() !< Control structure for a child module type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() !< Control structure for a child module @@ -383,9 +379,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: dt_mix ! amount of time over which to apply mixing [s] real :: Idt ! inverse time step [s-1] - type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth - integer :: num_z_diags ! number of diagnostics to be interpolated to depth - integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo @@ -901,8 +894,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diag_update_remap_grids(CS%diag) ! diagnostics - if ((CS%id_Tdif > 0) .or. (CS%id_Tdif_z > 0) .or. & - (CS%id_Tadv > 0) .or. (CS%id_Tadv_z > 0)) then + if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 @@ -915,8 +907,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) enddo ; enddo ; enddo endif - if ((CS%id_Sdif > 0) .or. (CS%id_Sdif_z > 0) .or. & - (CS%id_Sadv > 0) .or. (CS%id_Sadv_z > 0)) then + if ((CS%id_Sdif > 0) .or. (CS%id_Sadv > 0)) then do j=js,je ; do i=is,ie Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 @@ -1124,31 +1115,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call disable_averaging(CS%diag) - num_z_diags = 0 - if (CS%id_Kd_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_z ; z_ptrs(num_z_diags)%p => Kd_int - endif - if (CS%id_Tdif_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Tdif_z ; z_ptrs(num_z_diags)%p => Tdif_flx - endif - if (CS%id_Tadv_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Tadv_z ; z_ptrs(num_z_diags)%p => Tadv_flx - endif - if (CS%id_Sdif_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Sdif_z ; z_ptrs(num_z_diags)%p => Sdif_flx - endif - if (CS%id_Sadv_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Sadv_z ; z_ptrs(num_z_diags)%p => Sadv_flx - endif - - if (num_z_diags > 0) & - call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) if (showCallTree) call callTree_leave("diabatic()") @@ -1269,9 +1235,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: dt_mix ! amount of time over which to apply mixing [s] real :: Idt ! inverse time step [s-1] - type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth - integer :: num_z_diags ! number of diagnostics to be interpolated to depth - integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo @@ -2056,8 +2019,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call diag_update_remap_grids(CS%diag) ! diagnostics - if ((CS%id_Tdif > 0) .or. (CS%id_Tdif_z > 0) .or. & - (CS%id_Tadv > 0) .or. (CS%id_Tadv_z > 0)) then + if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 @@ -2070,8 +2032,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) enddo ; enddo ; enddo endif - if ((CS%id_Sdif > 0) .or. (CS%id_Sdif_z > 0) .or. & - (CS%id_Sadv > 0) .or. (CS%id_Sadv_z > 0)) then + if ((CS%id_Sdif > 0) .or. (CS%id_Sadv > 0)) then do j=js,je ; do i=is,ie Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 @@ -2426,31 +2387,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call disable_averaging(CS%diag) - num_z_diags = 0 - if (CS%id_Kd_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_z ; z_ptrs(num_z_diags)%p => Kd_int - endif - if (CS%id_Tdif_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Tdif_z ; z_ptrs(num_z_diags)%p => Tdif_flx - endif - if (CS%id_Tadv_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Tadv_z ; z_ptrs(num_z_diags)%p => Tadv_flx - endif - if (CS%id_Sdif_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Sdif_z ; z_ptrs(num_z_diags)%p => Sdif_flx - endif - if (CS%id_Sadv_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Sadv_z ; z_ptrs(num_z_diags)%p => Sadv_flx - endif - - if (num_z_diags > 0) & - call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) if (showCallTree) call callTree_leave("diabatic()") @@ -2735,7 +2671,7 @@ end subroutine diagnose_frazil_tendency !! tracer column functions to be called without allowing any !! of the diabatic processes to be used. subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & - tracer_flow_CSp, diag_to_Z_CSp) + tracer_flow_CSp) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< model grid structure type(param_file_type), intent(in) :: param_file !< the file to parse for parameter values @@ -2743,7 +2679,6 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & type(diabatic_CS), pointer :: CS !< module control structure type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the !! tracer flow control module - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to Z-diagnostics control structure ! This "include" declares and sets the variable "version". #include "version_variable.h" @@ -2757,7 +2692,6 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & CS%diag => diag if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp - if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp ! Set default, read and log parameters call log_version(param_file, mdl, version, & @@ -2769,7 +2703,7 @@ end subroutine adiabatic_driver_init !> This routine initializes the diabatic driver module. subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, diag, & ADp, CDp, CS, tracer_flow_CSp, sponge_CSp, & - ALE_sponge_CSp, diag_to_Z_CSp) + ALE_sponge_CSp) type(time_type), target :: Time !< model time type(ocean_grid_type), intent(inout) :: G !< model grid structure type(verticalGrid_type), intent(in) :: GV !< model vertical grid structure @@ -2785,12 +2719,10 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di !! tracer flow control module type(sponge_CS), pointer :: sponge_CSp !< pointer to the sponge module control structure type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< pointer to the ALE sponge module control structure - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control structure real :: Kd integer :: num_mode logical :: use_temperature, differentialDiffusion - type(vardesc) :: vd ! This "include" declares and sets the variable "version". #include "version_variable.h" @@ -2816,7 +2748,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp if (associated(sponge_CSp)) CS%sponge_CSp => sponge_CSp if (associated(ALE_sponge_CSp)) CS%ALE_sponge_CSp => ALE_sponge_CSp - if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp CS%useALEalgorithm = useALEalgorithm CS%bulkmixedlayer = (GV%nkml > 0) @@ -3041,29 +2972,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "stratification at the base of the mixed layer.", & units='m', default=50.0, scale=US%m_to_Z) - ! diagnostics making use of the z-gridding code - if (associated(diag_to_Z_CSp)) then - vd = var_desc("Kd_interface", "m2 s-1", & - "Diapycnal diffusivity at interfaces, interpolated to z", z_grid='z') - CS%id_Kd_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Tflx_dia_diff", "degC m s-1", & - "Diffusive diapycnal temperature flux across interfaces, interpolated to z", & - z_grid='z') - CS%id_Tdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Tflx_dia_adv", "degC m s-1", & - "Advective diapycnal temperature flux across interfaces, interpolated to z", & - z_grid='z') - CS%id_Tadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Sflx_dia_diff", "psu m s-1", & - "Diffusive diapycnal salinity flux across interfaces, interpolated to z", & - z_grid='z') - CS%id_Sdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Sflx_dia_adv", "psu m s-1", & - "Advective diapycnal salinity flux across interfaces, interpolated to z", & - z_grid='z') - CS%id_Sadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - if (CS%id_dudt_dia > 0) call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) if (CS%id_dvdt_dia > 0) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) @@ -3084,7 +2992,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif - !call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp) + !call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, CS%int_tide_CSp) CS%id_Kd_interface = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_energetic_PBL) then @@ -3299,7 +3207,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif ! 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, diag_to_Z_CSp, & + CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, diag, & CS%tidal_mixing_CSp) ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise @@ -3320,10 +3228,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & + call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, & CS%int_tide_CSp, CS%tidal_mixing_CSp, CS%halo_TS_diff) - ! set up the clocks for this module id_clock_entrain = cpu_clock_id('(Ocean diabatic entrain)', grain=CLOCK_MODULE) if (CS%bulkmixedlayer) & diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index f1276be827..fd159b9f5f 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -7,7 +7,6 @@ module MOM_int_tide_input use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_diag_mediator, only : safe_alloc_ptr, post_data, register_diag_field -use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_debugging, only : hchksum use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_param, log_version, param_file_type diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c5fe83a9e7..a167add87c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -7,7 +7,6 @@ module MOM_set_diffusivity use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_diag_mediator, only : post_data, register_diag_field -use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_debugging, only : hchksum, uvchksum, Bchksum use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE @@ -21,7 +20,7 @@ module MOM_set_diffusivity use MOM_tidal_mixing, only : tidal_mixing_CS, calculate_tidal_mixing use MOM_tidal_mixing, only : setup_tidal_diagnostics, post_tidal_diagnostics use MOM_intrinsic_functions, only : invcosh -use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data +use MOM_io, only : slasher, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS use MOM_kappa_shear, only : calc_kappa_shear_vertex, kappa_shear_at_vertex use MOM_CVMix_shear, only : calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_cs @@ -149,7 +148,6 @@ module MOM_set_diffusivity character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< Control structure for a child module type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() !< Control structure for a child module type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() !< Control structure for a child module type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() !< Control structure for a child module @@ -159,10 +157,8 @@ module MOM_set_diffusivity !>@{ Diagnostic IDs integer :: id_maxTKE = -1, id_TKE_to_Kd = -1, id_Kd_user = -1 - integer :: id_Kd_layer = -1, id_Kd_BBL = -1, id_Kd_BBL_z = -1 - integer :: id_Kd_user_z = -1, id_N2 = -1, id_N2_z = -1 + integer :: id_Kd_layer = -1, id_Kd_BBL = -1, id_N2 = -1 integer :: id_Kd_Work = -1, id_KT_extra = -1, id_KS_extra = -1 - integer :: id_KT_extra_z = -1, id_KS_extra_z = -1 !!@} end type set_diffusivity_CS @@ -260,11 +256,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2] logical :: use_EOS ! If true, compute density from T/S using equation of state. - type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space integer :: kb(SZI_(G)) ! The index of the lightest layer denser than the ! buffer layer, or -1 without a bulk mixed layer. - integer :: num_z_diags ! number of diagns to be interpolated to depth space - integer :: z_ids(6) ! id numbers of diagns to be interpolated to depth space logical :: showCallTree ! If true, show the call tree. integer :: i, j, k, is, ie, js, je, nz @@ -302,10 +295,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set up arrays for diagnostics. - if ((CS%id_N2 > 0) .or. (CS%id_N2_z > 0)) then + if (CS%id_N2 > 0) then allocate(dd%N2_3d(isd:ied,jsd:jed,nz+1)) ; dd%N2_3d(:,:,:) = 0.0 endif - if ((CS%id_Kd_user > 0) .or. (CS%id_Kd_user_z > 0)) then + if (CS%id_Kd_user > 0) then allocate(dd%Kd_user(isd:ied,jsd:jed,nz+1)) ; dd%Kd_user(:,:,:) = 0.0 endif if (CS%id_Kd_work > 0) then @@ -317,13 +310,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_TKE_to_Kd > 0) then allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 endif - if ((CS%id_KT_extra > 0) .or. (CS%id_KT_extra_z > 0)) then + if (CS%id_KT_extra > 0) then allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 endif - if ((CS%id_KS_extra > 0) .or. (CS%id_KS_extra_z > 0)) then + if (CS%id_KS_extra > 0) then allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 endif - if ((CS%id_Kd_BBL > 0) .or. (CS%id_Kd_BBL_z > 0)) then + if (CS%id_Kd_BBL > 0) then allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 endif @@ -597,7 +590,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! tidal mixing call post_tidal_diagnostics(G,GV,h,CS%tm_csp) - num_z_diags = 0 if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & CS%tm_csp%Lowmode_itidal_dissipation) then @@ -606,46 +598,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_Kd_Work > 0) call post_data(CS%id_Kd_Work, dd%Kd_Work, CS%diag) if (CS%id_maxTKE > 0) call post_data(CS%id_maxTKE, dd%maxTKE, CS%diag) if (CS%id_TKE_to_Kd > 0) call post_data(CS%id_TKE_to_Kd, dd%TKE_to_Kd, CS%diag) - - if (CS%id_N2_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_N2_z - z_ptrs(num_z_diags)%p => dd%N2_3d - endif - - if (CS%id_Kd_user_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_user_z - z_ptrs(num_z_diags)%p => dd%Kd_user - endif - endif if (CS%id_KT_extra > 0) call post_data(CS%id_KT_extra, dd%KT_extra, CS%diag) if (CS%id_KS_extra > 0) call post_data(CS%id_KS_extra, dd%KS_extra, CS%diag) if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) - if (CS%id_KT_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KT_extra_z - z_ptrs(num_z_diags)%p => dd%KT_extra - endif - - if (CS%id_KS_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KS_extra_z - z_ptrs(num_z_diags)%p => dd%KS_extra - endif - - if (CS%id_Kd_BBL_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_BBL_z - z_ptrs(num_z_diags)%p => dd%Kd_BBL - endif - - if (num_z_diags > 0) & - call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) - if (associated(dd%N2_3d)) deallocate(dd%N2_3d) if (associated(dd%Kd_work)) deallocate(dd%Kd_work) if (associated(dd%Kd_user)) deallocate(dd%Kd_user) @@ -1899,7 +1857,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios -subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, & +subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_CSp, & tm_CSp, halo_TS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -1910,8 +1868,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z 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(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control - !! structure. type(int_tide_CS), pointer :: int_tide_CSp !< pointer to the internal tides control !! structure (BDM) type(tidal_mixing_cs), pointer :: tm_csp !< pointer to tidal mixing control @@ -1921,7 +1877,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z ! local variables real :: decay_length - type(vardesc) :: vd logical :: ML_use_omega ! This include declares and sets the variable "version". @@ -1945,7 +1900,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%diag => diag if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp if (associated(tm_csp)) CS%tm_csp => tm_csp - if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp ! These default values always need to be set. CS%BBL_mixing_as_max = .true. @@ -2181,14 +2135,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z if (CS%user_change_diff) & CS%id_Kd_user = register_diag_field('ocean_model', 'Kd_user', diag%axesTi, Time, & 'User-specified Extra Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - - if (associated(diag_to_Z_CSp)) then - vd = var_desc("N2", "s-2", & - "Buoyancy frequency, interpolated to z", z_grid='z') - CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%s_to_T**2) - if (CS%user_change_diff) & - CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z2_T_to_m2_s) - endif endif call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & @@ -2216,23 +2162,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%id_KS_extra = register_diag_field('ocean_model', 'KS_extra', diag%axesTi, Time, & 'Double-diffusive diffusivity for salinity', 'm2 s-1', & conversion=US%Z2_T_to_m2_s) - - if (associated(diag_to_Z_CSp)) then - vd = var_desc("KT_extra", "m2 s-1", & - "Double-Diffusive Temperature Diffusivity, interpolated to z", & - z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=US%Z2_T_to_m2_s) - vd = var_desc("KS_extra", "m2 s-1", & - "Double-Diffusive Salinity Diffusivity, interpolated to z", & - z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=US%Z2_T_to_m2_s) - vd = var_desc("Kd_BBL", "m2 s-1", & - "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, & - conversion=US%Z2_T_to_m2_s) - endif endif ! old double-diffusion if (CS%user_change_diff) then diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b82313dc6c..5144ef0a08 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -5,15 +5,13 @@ module MOM_tidal_mixing use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : safe_alloc_ptr, post_data -use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag -use MOM_diag_to_Z, only : calc_Zint_diags use MOM_debugging, only : hchksum use MOM_EOS, only : calculate_density use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : openParameterBlock, closeParameterBlock 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, vardesc, var_desc, field_size +use MOM_io, only : slasher, MOM_read_data, field_size 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 @@ -163,8 +161,6 @@ module MOM_tidal_mixing ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< A pointer to the control structure - !! for remapping diagnostics into Z-space type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays !>@{ Diagnostic identifiers @@ -173,9 +169,6 @@ module MOM_tidal_mixing integer :: id_Kd_itidal = -1 integer :: id_Kd_Niku = -1 integer :: id_Kd_lowmode = -1 - integer :: id_Kd_itidal_z = -1 - integer :: id_Kd_Niku_z = -1 - integer :: id_Kd_lowmode_z = -1 integer :: id_Kd_Itidal_Work = -1 integer :: id_Kd_Niku_Work = -1 integer :: id_Kd_Lowmode_Work = -1 @@ -210,14 +203,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, diag_to_Z_CSp, CS) +logical function tidal_mixing_init(Time, G, GV, US, param_file, 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(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control type(tidal_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables @@ -226,7 +218,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file - type(vardesc) :: vd real :: utide, hamp, prandtl_tidal real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je @@ -249,7 +240,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed CS%diag => diag - if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp ! Read parameters call log_version(param_file, mdl, version, & @@ -632,24 +622,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) endif endif ! S%use_CVMix_tidal - - if (associated(CS%diag_to_Z_CSp)) then - vd = var_desc("Kd_itides","m2 s-1", & - "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) - if (CS%Lee_wave_dissipation) then - vd = var_desc("Kd_Nikurashin", "m2 s-1", & - "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) - endif - if (CS%Lowmode_itidal_dissipation) then - vd = var_desc("Kd_lowmode","m2 s-1", & - "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& - z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) - endif - endif - endif end function tidal_mixing_init @@ -1357,12 +1329,10 @@ subroutine setup_tidal_diagnostics(G,CS) isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke dd => CS%dd - if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & - (CS%id_Kd_Itidal_work > 0)) then + if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) then allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Kd_itidal(:,:,:) = 0.0 endif - if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_z > 0) .or. & - (CS%id_Kd_lowmode_work > 0)) then + if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) then allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Kd_lowmode(:,:,:) = 0.0 endif if ( (CS%id_Fl_itidal > 0) ) then @@ -1385,8 +1355,7 @@ subroutine setup_tidal_diagnostics(G,CS) allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed)) dd%Polzin_decay_scale_scaled(:,:) = 0.0 endif - if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_z > 0) .or. & - (CS%id_Kd_Niku_work > 0)) then + if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) then allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1)) ; dd%Kd_Niku(:,:,:) = 0.0 endif if (CS%id_Kd_Niku_work > 0) then @@ -1442,12 +1411,8 @@ subroutine post_tidal_diagnostics(G, GV, h ,CS) type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local - integer :: num_z_diags - integer :: z_ids(6) ! id numbers of diagns to be interpolated to depth space - type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space type(tidal_mixing_diags), pointer :: dd => NULL() - num_z_diags = 0 dd => CS%dd if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then @@ -1479,30 +1444,8 @@ subroutine post_tidal_diagnostics(G, GV, h ,CS) call post_data(CS%id_Polzin_decay_scale, 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) - - if (CS%id_Kd_itidal_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_itidal_z - z_ptrs(num_z_diags)%p => dd%Kd_itidal - endif - - if (CS%id_Kd_Niku_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_Niku_z - z_ptrs(num_z_diags)%p => dd%Kd_Niku - endif - - if (CS%id_Kd_lowmode_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_lowmode_z - z_ptrs(num_z_diags)%p => dd%Kd_lowmode - endif - endif - if (num_z_diags > 0) & - call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) - 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) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 45eebb983e..f5bf27bf69 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -4,7 +4,6 @@ module DOME_tracer ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -141,7 +140,7 @@ end function register_DOME_tracer !> Initializes the NTR tracer fields in tr(:,:,:,:) and sets up the tracer output. subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp, param_file) + sponge_CSp, param_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -155,8 +154,6 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & !! call to DOME_register_tracer. type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure !! for the sponges, if they are in use. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 36bc3edb65..730cee813a 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -11,7 +11,6 @@ module ISOMIP_tracer ! Adapted to the ISOMIP test case by Gustavo Marques, May 2016 use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -146,7 +145,7 @@ end function register_ISOMIP_tracer !> Initializes the NTR tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & - ALE_sponge_CSp, diag_to_Z_CSp) + ALE_sponge_CSp) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -164,8 +163,6 @@ subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< A pointer to the control structure for !! the sponges, if they are in use. Otherwise this !! may be unassociated. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. real, allocatable :: temp(:,:,:) real, pointer, dimension(:,:,:) :: & diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 805409c16b..75e413df32 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -4,7 +4,6 @@ module MOM_OCMIP2_CFC ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -314,7 +313,7 @@ end subroutine flux_init_OCMIP2_CFC !> Initialize the OCMP2 CFC tracer fields and set up the tracer output. subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp) + 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. @@ -333,8 +332,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. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. ! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 2b732c5cc3..3b2a16475f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -20,17 +20,16 @@ module MOM_generic_tracer use g_tracer_utils, only: g_tracer_get_name,g_tracer_set_values,g_tracer_set_common,g_tracer_get_common use g_tracer_utils, only: g_tracer_get_next,g_tracer_type,g_tracer_is_prog,g_tracer_flux_init use g_tracer_utils, only: g_tracer_send_diag,g_tracer_get_values - use g_tracer_utils, only: g_tracer_get_pointer,g_tracer_get_alias,g_diag_type,g_tracer_set_csdiag + use g_tracer_utils, only: g_tracer_get_pointer,g_tracer_get_alias,g_tracer_set_csdiag use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, get_diag_time_end - use MOM_diag_to_Z, only : register_Z_tracer, diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing, optics_type use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type - use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc + use MOM_io, only : file_exists, MOM_read_data, slasher use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_spatial_means, only : global_area_mean use MOM_sponge, only : set_up_sponge_field, sponge_CS @@ -74,9 +73,6 @@ module MOM_generic_tracer ! The following pointer will be directed to the first element of the ! linked list of generic tracers. type(g_tracer_type), pointer :: g_tracer_list => NULL() - ! The following pointer will be directed to the first element of the - ! linked list of generic diagnostics fields that must be Z registered by MOM. - type(g_diag_type), pointer :: g_diag_list => NULL() integer :: H_to_m !Auxiliary to access GV%H_to_m in routines that do not have access to GV @@ -224,7 +220,7 @@ end function register_MOM_generic_tracer !! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, CS, & - sponge_CSp, ALE_sponge_CSp,diag_to_Z_CSp) + sponge_CSp, ALE_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. @@ -240,15 +236,12 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< Pointer to the control structure for the !! ALE sponges. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. character(len=fm_string_len), parameter :: sub_name = 'initialize_MOM_generic_tracer' logical :: OK integer :: i, j, k, isc, iec, jsc, jec, nk type(g_tracer_type), pointer :: g_tracer,g_tracer_next - type(g_diag_type) , pointer :: g_diag,g_diag_next - character(len=fm_string_len) :: g_tracer_name, longname, units + character(len=fm_string_len) :: g_tracer_name real, dimension(:,:,:,:), pointer :: tr_field real, dimension(:,:,:), pointer :: tr_ptr real, dimension(G%isd:G%ied, G%jsd:G%jed,1:G%ke) :: grid_tmask @@ -379,48 +372,6 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, call g_tracer_set_csdiag(CS%diag) #endif - - ! Register Z diagnostic output. - !Get the tracer list - if (.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& - ": No tracer in the list.") - !For each tracer name get its fields - g_tracer=>CS%g_tracer_list - do - call g_tracer_get_alias(g_tracer,g_tracer_name) - - call g_tracer_get_pointer(g_tracer,g_tracer_name,'field',tr_field) - tr_ptr => tr_field(:,:,:,1) - call g_tracer_get_values(g_tracer,g_tracer_name,'longname', longname) - call g_tracer_get_values(g_tracer,g_tracer_name,'units',units ) - - call register_Z_tracer(tr_ptr, trim(g_tracer_name),longname , units, & - day, G, diag_to_Z_CSp) - - !traverse the linked list till hit NULL - call g_tracer_get_next(g_tracer, g_tracer_next) - if (.NOT. associated(g_tracer_next)) exit - g_tracer=>g_tracer_next - - enddo - - !For each special diagnostics name get its fields - !Get the diag list - call generic_tracer_get_diag_list(CS%g_diag_list) - if (associated(CS%g_diag_list)) then - g_diag=>CS%g_diag_list - do - if (g_diag%Z_diag /= 0) & - call register_Z_tracer(g_diag%field_ptr, trim(g_diag%name),g_diag%longname , g_diag%units, & - day, G, diag_to_Z_CSp) - - !traverse the linked list till hit NULL - g_diag=>g_diag%next - if (.NOT. associated(g_diag)) exit - - enddo - endif - CS%H_to_m = GV%H_to_m end subroutine initialize_MOM_generic_tracer diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index dd44fb15b2..02275d7ad9 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -3,7 +3,7 @@ module MOM_tracer_Z_init ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_to_Z, only : find_overlap, find_limited_slope +!use MOM_diag_to_Z, only : find_overlap, find_limited_slope use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe ! use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -401,5 +401,103 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & end subroutine read_Z_edges +!### `find_overlap` and `find_limited_slope` were previously part of +! MOM_diag_to_Z.F90, and are nearly identical to `find_overlap` in +! `midas_vertmap.F90` with some slight differences. We keep it here for +! reproducibility, but the two should be merged at some point + +!> Determines the layers bounded by interfaces e that overlap +!! with the depth range between Z_top and Z_bot, and the fractional weights +!! of each layer. It also calculates the normalized relative depths of the range +!! of each layer that overlaps that depth range. + +! ### TODO: Merge with midas_vertmap.F90:find_overlap() +subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) + real, dimension(:), intent(in) :: e !< Column interface heights, in arbitrary units. + real, intent(in) :: Z_top !< Top of range being mapped to, in the units of e. + real, intent(in) :: Z_bot !< Bottom of range being mapped to, in the units of e. + integer, intent(in) :: k_max !< Number of valid layers. + integer, intent(in) :: k_start !< Layer at which to start searching. + integer, intent(inout) :: k_top !< Indices of top layers that overlap with the depth + !! range. + integer, intent(inout) :: k_bot !< Indices of bottom layers that overlap with the + !! depth range. + real, dimension(:), intent(out) :: wt !< Relative weights of each layer from k_top to k_bot. + real, dimension(:), intent(out) :: z1 !< Depth of the top limits of the part of + !! a layer that contributes to a depth level, relative to the cell center and normalized + !! by the cell thickness [nondim]. Note that -1/2 <= z1 < z2 <= 1/2. + real, dimension(:), intent(out) :: z2 !< Depths of the bottom limit of the part of + !! a layer that contributes to a depth level, relative to the cell center and normalized + !! by the cell thickness [nondim]. Note that -1/2 <= z1 < z2 <= 1/2. + ! Local variables + real :: Ih, e_c, tot_wt, I_totwt + integer :: k + + do k=k_start,k_max ; if (e(K+1)k_max) return + + ! Determine the fractional weights of each layer. + ! Note that by convention, e and Z_int decrease with increasing k. + if (e(K+1)<=Z_bot) then + wt(k) = 1.0 ; k_bot = k + Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) + e_c = 0.5*(e(K)+e(K+1)) + z1(k) = (e_c - MIN(e(K),Z_top)) * Ih + z2(k) = (e_c - Z_bot) * Ih + else + wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. + if (e(K) /= e(K+1)) then + z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) + else ; z1(k) = -0.5 ; endif + z2(k) = 0.5 + k_bot = k_max + do k=k_top+1,k_max + if (e(K+1)<=Z_bot) then + k_bot = k + wt(k) = e(K) - Z_bot ; z1(k) = -0.5 + if (e(K) /= e(K+1)) then + z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + else ; z2(k) = 0.5 ; endif + else + wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 + endif + tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. + if (k>=k_bot) exit + enddo + + I_totwt = 1.0 / tot_wt + do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + endif + +end subroutine find_overlap + +!> This subroutine determines a limited slope for val to be advected with +!! a piecewise limited scheme. +! ### TODO: Merge with midas_vertmap.F90:find_limited_slope() +subroutine find_limited_slope(val, e, slope, k) + real, dimension(:), intent(in) :: val !< A column of values that are being interpolated. + real, dimension(:), intent(in) :: e !< Column interface heights in arbitrary units + real, intent(out) :: slope !< Normalized slope in the intracell distribution of val. + integer, intent(in) :: k !< Layer whose slope is being determined. + ! Local variables + real :: d1, d2 ! Thicknesses in the units of e. + + d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) + if (((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) .or. (d1*d2 <= 0.0)) then + slope = 0.0 ! ; curvature = 0.0 + else + slope = (d1**2*(val(k+1) - val(k)) + d2**2*(val(k) - val(k-1))) * & + ((e(K) - e(K+1)) / (d1*d2*(d1+d2))) + ! slope = 0.5*(val(k+1) - val(k-1)) + ! This is S.J. Lin's form of the PLM limiter. + slope = sign(1.0,slope) * min(abs(slope), & + 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & + 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) + ! curvature = 0.0 + endif + +end subroutine find_limited_slope + end module MOM_tracer_Z_init diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index a3c75bd7fd..6c5493198a 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -4,7 +4,6 @@ module MOM_tracer_flow_control ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : time_type, diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type, close_param_file use MOM_forcing_type, only : forcing, optics_type @@ -271,7 +270,7 @@ end subroutine call_tracer_register !> This subroutine calls all registered tracer initialization !! subroutines. subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag, OBC, & - CS, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp, tv) + CS, sponge_CSp, ALE_sponge_CSp, tv) logical, intent(in) :: restart !< 1 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. @@ -297,8 +296,6 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< A pointer to the control !! structure for the ALE sponges, if they are in use. !! Otherwise this may be unassociated. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control - !! structure for diagnostics in depth space. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables @@ -308,42 +305,41 @@ 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, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp) if (CS%use_DOME_tracer) & call initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS%DOME_tracer_CSp, & - sponge_CSp, diag_to_Z_CSp, param_file) + sponge_CSp, param_file) if (CS%use_ISOMIP_tracer) & call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, & - ALE_sponge_CSp, diag_to_Z_CSp) + ALE_sponge_CSp) if (CS%use_ideal_age) & call initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS%ideal_age_tracer_CSp, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp) if (CS%use_regional_dyes) & call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp) if (CS%use_oil) & call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp) if (CS%use_advection_test_tracer) & call initialize_advection_test_tracer(restart, day, G, GV, h, diag, OBC, CS%advection_test_tracer_CSp, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp) if (CS%use_OCMIP2_CFC) & call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp) #ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) & call initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, & - CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp) + CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp) #endif if (CS%use_pseudo_salt_tracer) & call initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & - sponge_CSp, diag_to_Z_CSp, tv) + 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, & - sponge_CSp, diag_to_Z_CSp, tv) + 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, & - diag_to_Z_CSp) + call initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS%dyed_obc_tracer_CSp) end subroutine tracer_flow_control_init diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index f5c7d65f03..cbaf18d983 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -12,7 +12,6 @@ module MOM_tracer_registry use MOM_diag_mediator, only : diag_ctrl, register_diag_field, post_data, safe_alloc_ptr use MOM_diag_mediator, only : diag_grid_storage use MOM_diag_mediator, only : diag_copy_storage_to_diag, diag_save_grids, diag_restore_grids -use MOM_diag_to_Z, only : register_Z_tracer, diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type @@ -321,7 +320,7 @@ end subroutine lock_tracer_registry !> register_tracer_diagnostics does a set of register_diag_field calls for any previously !! registered in a tracer registry with a value of registry_diags set to .true. -subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_to_Z_CSp) +subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE) 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(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry @@ -331,8 +330,6 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_ type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output logical, intent(in) :: use_ALE !< If true active diagnostics that only !! apply to ALE configurations - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. character(len=24) :: name ! A variable's name in a NetCDF file. character(len=24) :: shortnm ! A shortened version of a variable's name for @@ -528,14 +525,6 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_ enddo ; enddo ; enddo endif - if (len_trim(cmorname) == 0) then - call register_Z_tracer(Tr%t, name, longname, units, Time, G, diag_to_Z_CSp) - else - call register_Z_tracer(Tr%t, name, longname, units, Time, G, diag_to_Z_CSp, & - cmor_field_name=cmorname, cmor_standard_name=cmor_long_std(cmor_longname), & - cmor_long_name=cmor_longname) - endif - ! Vertical regridding/remapping tendencies if (use_ALE .and. Tr%remap_tr) then var_lname = "Vertical remapping tracer concentration tendency for "//trim(Reg%Tr(m)%name) diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 34f788c952..b43a771a6f 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -4,7 +4,6 @@ module advection_test_tracer ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -164,7 +163,7 @@ end function register_advection_test_tracer !> Initializes the NTR tracer fields in tr(:,:,:,:) and it sets up the tracer output. subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp) + 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. @@ -180,8 +179,6 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. ! Local variables real, allocatable :: temp(:,:,:) diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index fa95d8aa77..28dbbf1c3b 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -4,7 +4,6 @@ module boundary_impulse_tracer ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -149,7 +148,7 @@ 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, & - sponge_CSp, diag_to_Z_CSp, tv) + 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. @@ -165,8 +164,6 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables ! Local variables diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 899d0cee67..35ab47a192 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -4,7 +4,6 @@ module regional_dyes ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -184,8 +183,7 @@ end function register_dye_tracer !> This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. -subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, & - diag_to_Z_CSp) +subroutine initialize_dye_tracer(restart, day, G, GV, 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. @@ -200,8 +198,6 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C !! call to register_dye_tracer. type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure !! for the sponges, if they are in use. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. ! Local variables character(len=24) :: name ! A variable's name in a NetCDF file. diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 7abbafa5fc..13b35894af 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -4,7 +4,6 @@ module dyed_obc_tracer ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -132,7 +131,7 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) end function register_dyed_obc_tracer !> Initializes the CS%ntr tracer fields in tr(:,:,:,:) and sets up the tracer output. -subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, diag_to_Z_CSp) +subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure logical, intent(in) :: restart !< .true. if the fields have already @@ -143,8 +142,6 @@ subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, dia type(ocean_OBC_type), pointer :: OBC !< Structure specifying open boundary options. type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to dyed_obc_register_tracer. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. ! Local variables real, allocatable :: temp(:,:,:) diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 562947a011..206fff0247 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -4,7 +4,6 @@ module ideal_age_example ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -194,7 +193,7 @@ end function register_ideal_age_tracer !> Sets the ideal age traces to their initial values and sets up the tracer output subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp) + 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. @@ -211,8 +210,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. + ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 6156c20e24..3dfa295bbb 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -4,7 +4,6 @@ module oil_tracer ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -202,7 +201,7 @@ end function register_oil_tracer !> Initialize the oil tracers and set up tracer output subroutine initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp) + 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. @@ -219,8 +218,6 @@ subroutine initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. ! Local variables character(len=16) :: name ! A variable's name in a NetCDF file. diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index e41ab90095..ea3ccb8928 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -6,7 +6,6 @@ module pseudo_salt_tracer 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_diag_to_Z, only : diag_to_Z_CS 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 @@ -114,7 +113,7 @@ end function register_pseudo_salt_tracer !> Initialize the pseudo-salt tracer subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp, tv) + 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. @@ -130,8 +129,6 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, 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(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! This subroutine initializes the tracer fields in CS%ps(:,:,:). diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 26ea3fb957..9dbb3f8734 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -4,7 +4,6 @@ module USER_tracer_example ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS 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 @@ -137,7 +136,7 @@ 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, & - sponge_CSp, diag_to_Z_CSp) + 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. @@ -154,8 +153,6 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & !! call to USER_register_tracer_example. type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure !! for the sponges, if they are in use. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure - !! for diagnostics in depth space. ! Local variables real, allocatable :: temp(:,:,:) From 3ee695535f6d05968d300555efe8077bd7cc542c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 21 May 2019 15:13:15 -0400 Subject: [PATCH 066/106] Z_OUTPUT_GRID_FILE parameter obsolescence --- src/diagnostics/MOM_obsolete_params.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 3ae1b70c14..797db75240 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -202,6 +202,7 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") + call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") ! Write the file version number to the model log. call log_version(param_file, mdl, version) From 56e3613430e72a9a84c572faa04e87ed66b9d6bc Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Wed, 22 May 2019 10:00:42 -0400 Subject: [PATCH 067/106] Updating the MOM_CVMix_KPP code - Remove explicit dependence on optional WAVES control structure to use Langmuir parameterization - The Langmuir term can be used w/ forms of Langmuir number that shouldn't require the WAVE module to be present. --- .../vertical/MOM_CVMix_KPP.F90 | 34 ++++++++----------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 68d7085b30..6fc672b137 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -147,6 +147,7 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [m] without smoothing real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [m] + real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [kg m-3] real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [m2 s-2] real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) @@ -536,6 +537,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%OBLdepth(:,:) = 0. allocate( CS%kOBL( SZI_(G), SZJ_(G) ) ) CS%kOBL(:,:) = 0. + allocate( CS%La_SL( SZI_(G), SZJ_(G) ) ) + CS%La_SL(:,:) = 0. allocate( CS%Vt2( SZI_(G), SZJ_(G), SZK_(G) ) ) CS%Vt2(:,:,:) = 0. if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) @@ -578,7 +581,7 @@ 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) + nonLocalTransScalar, waves) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -718,11 +721,11 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & LangEnhK = CS%KPP_K_ENH_FAC elseif (CS%LT_K_METHOD==LT_K_MODE_VR12) then ! Added minimum value for La_SL, so removed maximum value for LangEnhK. - LangEnhK = sqrt(1.+(1.5*WAVES%La_SL(i,j))**(-2) + & - (5.4*WAVES%La_SL(i,j))**(-4)) + LangEnhK = sqrt(1.+(1.5*CS%La_SL(i,j))**(-2) + & + (5.4*CS%La_SL(i,j))**(-4)) elseif (CS%LT_K_METHOD==LT_K_MODE_RW16) then !This maximum value is proposed in Reichl et al., 2016 JPO formula - LangEnhK = min(2.25, 1. + 1./WAVES%La_SL(i,j)) + LangEnhK = min(2.25, 1. + 1./CS%La_SL(i,j)) else !This shouldn't be reached. !call MOM_error(WARNING,"Unexpected behavior in MOM_CVMix_KPP, see error in LT_K_ENHANCEMENT") @@ -1069,15 +1072,10 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF enddo ! k-loop finishes if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then - if (.not.(present(WAVES).and.associated(WAVES))) then - call MOM_error(FATAL,"Trying to use input WAVES information in KPP\n"//& - "without activating USEWAVES") - endif - !For now get Langmuir number based on prev. MLD (otherwise must compute 3d LA) MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) - call get_Langmuir_Number( LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & + call get_Langmuir_Number( LA, G, GV, US, MLD_guess, surfFricVel, i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) - WAVES%La_SL(i,j)=LA + CS%La_SL(i,j)=LA endif @@ -1125,14 +1123,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_VR12) then !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. - enhvt2 = sqrt(1.+(1.5*WAVES%La_SL(i,j))**(-2) + & - (5.4*WAVES%La_SL(i,j))**(-4)) + enhvt2 = sqrt(1.+(1.5*CS%La_SL(i,j))**(-2) + & + (5.4*CS%La_SL(i,j))**(-4)) do k=1,G%ke LangEnhVT2(k) = enhvt2 enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_RW16) then !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. - enhvt2 = 1. + 2.3*WAVES%La_SL(i,j)**(-0.5) + enhvt2 = 1. + 2.3*CS%La_SL(i,j)**(-0.5) do k=1,G%ke LangEnhVT2(k) = enhvt2 enddo @@ -1141,7 +1139,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF do k=1,G%ke WST = (max(0.,-buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) LangEnhVT2(k) = sqrt((0.15*WST**3. + 0.17*surfFricVel**3.* & - (1.+0.49*WAVES%La_SL(i,j)**(-2.))) / & + (1.+0.49*CS%La_SL(i,j)**(-2.))) / & (0.2*ws_1d(k)**3/(CS%cs*CS%surf_layer_ext*CS%vonKarman**4.))) enddo else @@ -1314,11 +1312,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) if (CS%id_EnhK > 0) call post_data(CS%id_EnhK, CS%EnhK, CS%diag) if (CS%id_EnhVt2 > 0) call post_data(CS%id_EnhVt2, CS%EnhVt2, CS%diag) - if (present(WAVES)) then - if ((CS%id_La_SL>0) .and. associated(WAVES)) then - call post_data(CS%id_La_SL,WAVES%La_SL,CS%diag) - endif - endif + if (CS%id_La_SL > 0) call post_data(CS%id_La_SL, CS%La_SL, CS%diag) ! BLD smoothing: if (CS%n_smooth > 0) call KPP_smooth_BLD(CS,G,GV,h) From 1cb32f3f68946bf6f03febb15e0136074463a8c9 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Wed, 22 May 2019 11:17:52 -0400 Subject: [PATCH 068/106] Changes to MOM_wave_interface - Changes to facilitate running MOM6 with Langmuir turbulence but without WAVES control structure. - Changes to DHH85 spectra calculation to improve comparison w/ LF17 and GOTM simulations. --- src/user/MOM_wave_interface.F90 | 123 ++++++++++++++++++++------------ 1 file changed, 77 insertions(+), 46 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index d08c9f42ca..044343abc6 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -181,6 +181,7 @@ module MOM_wave_interface ! Options For Test Prof Real :: TP_STKX0, TP_STKY0, TP_WVL logical :: WaveAgePeakFreq ! Flag to use W +logical :: StaticWaves, DHH85_Is_Set real :: WaveAge, WaveWind real :: PI !!@} @@ -269,7 +270,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) units='', default=NULL_STRING) select case (TRIM(TMPSTRING1)) case (NULL_STRING)! No Waves - call MOM_error(FATAL, "wave_interface_init called with no specified"//& + call MOM_error(FATAL, "wave_interface_init called with no specified "//& "WAVE_METHOD.") case (TESTPROF_STRING)! Test Profile WaveMethod = TESTPROF @@ -343,6 +344,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) call get_param(param_file,mdl,"DHH85_WIND",WaveWind, & "Wind speed for DHH85 spectrum.", & units='', default=10.0) + call get_param(param_file,mdl,"STATIC_DHH85",StaticWaves, & + "Flag to disable updating DHH85 Stokes drift.", & + default=.false.) case (LF17_STRING)!Li and Fox-Kemper 17 wind-sea Langmuir number WaveMethod = LF17 case default @@ -353,7 +357,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & "The depth (normalized by BLD) to average Stokes drift over in \n"//& " Langmuir number calculation, where La = sqrt(ust/Stokes).", & - units="nondim",default=0.04) + units="nondim",default=0.2) call get_param(param_file, mdl, "LA_MISALIGNMENT", LA_Misalignment, & "Flag (logical) if using misalignment bt shear and waves in LA",& default=.false.) @@ -404,18 +408,37 @@ end subroutine MOM_wave_interface_init !! with the wind-speed dependent Stokes drift formulation of LF17 subroutine MOM_wave_interface_init_lite(param_file) type(param_file_type), intent(in) :: param_file !< Input parameter structure - + character*(5), parameter :: NULL_STRING = "EMPTY" + character*(4), parameter :: LF17_STRING = "LF17" + character*(13) :: TMPSTRING1 ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & "The depth (normalized by BLD) to average Stokes drift over in \n"//& " Langmuir number calculation, where La = sqrt(ust/Stokes).", & units="nondim",default=0.04) - if (WaveMethod==NULL_WaveMethod) then - ! Wave not initialized. Check for WaveMethod. Only allow LF17. - WaveMethod=LF17 + ! Get Wave Method and write to integer WaveMethod + ! At this point only LF17 is a valid choice, since the Waves module isn't initialized. + call get_param(param_file,mdl,"WAVE_METHOD",TMPSTRING1, & + "Choice of wave method, valid options include: \n"// & + " TEST_PROFILE - Prescribed from surface Stokes drift \n"// & + " and a decay wavelength.\n"// & + " SURFACE_BANDS - Computed from multiple surface values \n"// & + " and decay wavelengths.\n"// & + " DHH85 - Uses Donelan et al. 1985 empirical \n"// & + " wave spectrum with prescribed values. \n"// & + " LF17 - Infers Stokes drift profile from wind \n"// & + " speed following Li and Fox-Kemper 2017.\n", & + units='', default=NULL_STRING) + select case (TRIM(TMPSTRING1)) + case (NULL_STRING)! No Waves + WaveMethod = NULL_WaveMethod + case (LF17_STRING)!Li and Fox-Kemper 17 wind-sea Langmuir number + WaveMethod = LF17 PI=4.0*atan(1.0) - endif + case default + WaveMethod = NULL_WaveMethod + end select return end subroutine MOM_wave_interface_init_lite @@ -608,45 +631,48 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo enddo elseif (WaveMethod==DHH85) then - do II = G%isdB,G%iedB - do jj = G%jsd,G%jed - bottom = 0.0 - do kk = 1,G%ke - Top = Bottom - IIm1 = max(II-1,1) - MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) - Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) - !bgr note that this is using a u-point ii on h-point ustar - ! this code has only been previous used for uniform - ! grid cases. This needs fixed if DHH85 is used for non - ! uniform cases. - call DHH85_mid(GV, US, MidPoint, UStokes) - ! Putting into x-direction (no option for direction - CS%US_x(II,jj,kk) = UStokes + if (.not.(StaticWaves .and. DHH85_is_set)) then + do II = G%isdB,G%iedB + do jj = G%jsd,G%jed + bottom = 0.0 + do kk = 1,G%ke + Top = Bottom + IIm1 = max(II-1,1) + MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) + !bgr note that this is using a u-point ii on h-point ustar + ! this code has only been previous used for uniform + ! grid cases. This needs fixed if DHH85 is used for non + ! uniform cases. + call DHH85_mid(GV, US, MidPoint, UStokes) + ! Putting into x-direction (no option for direction + CS%US_x(II,jj,kk) = UStokes + enddo enddo enddo - enddo - do ii = G%isd,G%ied - do JJ = G%jsdB,G%jedB - Bottom = 0.0 - do kk=1, G%ke - Top = Bottom - JJm1 = max(JJ-1,1) - MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) - Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) - !bgr note that this is using a v-point jj on h-point ustar - ! this code has only been previous used for uniform - ! grid cases. This needs fixed if DHH85 is used for non - ! uniform cases. - ! call DHH85_mid(GV, US, Midpoint, UStokes) - ! Putting into x-direction, so setting y direction to 0 - CS%US_y(ii,JJ,kk) = 0.0 !### Note that =0 should be =US - RWH - ! bgr - see note above, but this is true - ! if this is used for anything - ! other than simple LES comparison + do ii = G%isd,G%ied + do JJ = G%jsdB,G%jedB + Bottom = 0.0 + do kk=1, G%ke + Top = Bottom + JJm1 = max(JJ-1,1) + MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + !bgr note that this is using a v-point jj on h-point ustar + ! this code has only been previous used for uniform + ! grid cases. This needs fixed if DHH85 is used for non + ! uniform cases. + ! call DHH85_mid(GV, US, Midpoint, UStokes) + ! Putting into x-direction, so setting y direction to 0 + CS%US_y(ii,JJ,kk) = 0.0 !### Note that =0 should be =US - RWH + ! bgr - see note above, but this is true + ! if this is used for anything + ! other than simple LES comparison + enddo enddo enddo - enddo + DHH85_is_set = .true. + endif else! Keep this else, fallback to 0 Stokes drift do kk= 1,G%ke do II = G%isdB,G%iedB @@ -669,7 +695,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do jj = G%jsc, G%jec Top = h(ii,jj,1)*GV%H_to_Z call get_Langmuir_Number( La, G, GV, US, Top, US%Z_to_m*ustar(ii,jj), ii, jj, & - Override_MA=.false.,WAVES=CS) + H(ii,jj,:),Override_MA=.false.,WAVES=CS) CS%La_turb(ii,jj) = La enddo enddo @@ -943,6 +969,10 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (WaveMethod==LF17) then call get_StokesSL_LiFoxKemper(ustar, hbl*LA_FracHBL, GV, US, LA_STK, LA) + else + LA_STK = 0.0 + LA = 1.e8 + return endif if (.not.(WaveMethod==LF17)) then @@ -1146,9 +1176,10 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 6.5 ! ~sqrt(0.2*(GV%g_Earth*US%m_to_Z)*2*pi/0.3) - domega = 0.05 - NOmega = (omega_max-omega_min)/domega + omega_max = 10. ! ~sqrt(0.2*(GV%g_Earth*US%m_to_Z)*2*pi/0.3) + NOmega = 1000 + domega = (omega_max-omega_min)/real(NOmega) + ! if (WaveAgePeakFreq) then omega_peak = (GV%g_Earth*US%m_to_Z) / (WA * u10) From 7914a4e4cfd2525b5b16f5539e745caf9c536428 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Wed, 22 May 2019 11:39:18 -0400 Subject: [PATCH 069/106] Adding ePBL tuning relationships needed to use versions from RH18/RL19 to MOM6 --- .../vertical/MOM_energetic_PBL.F90 | 123 ++++++++++++++++-- 1 file changed, 114 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7f8d08fb48..eb377c336f 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -58,6 +58,11 @@ module MOM_energetic_PBL !! energy is converted to a turbulent velocity, relative to !! mechanically forced turbulent kinetic energy [nondim]. !! Making this larger increases the diffusivity. + integer :: vstar_mode !< An integer marking the chosen method for finding vstar. + !! vstar = 0 is the original (TKE_remaining)^1/3 + !! vstar = 1 is the version described by Reichl and Hallberg, 2018 + real :: vstar_surf_fac !< If (vstar == 1) this is the proportionality coefficient between + !! ustar and the surface mechanical contribution to vstar real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit !! conversion factor. Making this larger increases the diffusivity. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the @@ -81,6 +86,7 @@ module MOM_energetic_PBL !! local stratification. This dissipation is applied to the available !! TKE which includes both that generated at the surface and that !! generated at depth. + !MSTAR related options real :: MSTAR_CAP !< Since MSTAR is restoring undissipated energy to mixing, !! there must be a cap on how large it can be. This !! is definitely a function of latitude (Ekman limit), @@ -92,9 +98,21 @@ module MOM_energetic_PBL real :: MSTAR_XINT_UP !< Similar but for transition to asymptotic cap. real :: MSTAR_AT_XINT !< Intercept value of MSTAR at value where function !! changes to linear transition. - integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) - real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancment - real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement + real :: RH18_mst_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). + !! Value of 0.275 in RH18. Increasing this + !! coefficient increases mechanical mixing for all values of Hf/ust, + !! but is most effective at low values (weakly developed OSBLs). + real :: RH18_mst_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). + !! Value of 8.0 in RH18. Increasing this coefficient increases MSTAR + !! for all values of HF/ust, with a consistent affect across + !! a wide range of Hf/ust. + real :: RH18_mst_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of + !! -5.0 in RH18. Increasing this increases how quickly the value + !! of MSTAR decreases as Hf/ust increases. + real :: RH18_mst_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. + !! Value of 0.2 in RH18. + real :: RH18_mst_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. + !! Value of 0.4 in RH18. real :: MSTAR_N = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB real :: MSTAR_A !< Coefficients of expressions for mstar in asymptotic limits, computed !! to match the function value and slope at both ends of the linear fit @@ -104,6 +122,14 @@ module MOM_energetic_PBL real :: MSTAR_B2 !< Coefficients of expressions for mstar in asymptotic limits. real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2 real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 + !Langmuir turbulence related parameters + integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) + real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancment + real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement + logical :: LT_ENH_K_R16 !< Logical to toggle enhanced local mixing coefficient due to Langmuir + !! following Reichl et al., 2016. This setting is unverified + !! outside of strongly shear-forced shear turbulence and therefore + !! it is not recommended to employ this option for general use. real :: LaC_MLDoEK !< Coefficient for Langmuir number modification based on the ratio of !! the mixed layer depth over the Ekman depth. real :: LaC_MLDoOB_stab !< Coefficient for Langmuir number modification based on the ratio of @@ -124,6 +150,7 @@ module MOM_energetic_PBL !! layer depth to the Obukhov depth integer :: EKMAN_o_OBUKHOV=2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman !! layer depth to the Obukhov depth + integer :: MSTAR_RH18 = 3 !< The value of MSTAR_MODE to base mstar off of RH18 logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated. logical :: Use_LT = .false. !< Flag for using LT in Energy calculation @@ -495,6 +522,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing. real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used. + real :: Surface_Scale ! Surface decay scale for vstar + real :: K_Enhancement ! A local enhancement of K, perhaps due to Langmuir turbulence + ! For LT_ENH_K_R16 + real :: Shape_Function ! The shape function of the enhancement + real :: Max_Shape_Function = 0.148148 ! The max value of the shape function of the enhancement + real :: Max_K_Enhancement = 2.25 ! The max value of the enhancement + !-End for LT_ENH_K_R16 logical :: debug=.false. ! Change this hard-coded value for debugging. ! The following arrays are used only for debugging purposes. @@ -784,9 +818,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. MSTAR_MIX = max(mstar_STAB, min(1.25, mstar_ROT)) - if (CS%MSTAR_CAP > 0.0) MSTAR_MIX = min(CS%MSTAR_CAP, MSTAR_MIX) - endif!mstar_mode==1 or ==2 + elseif (CS%MSTAR_MODE.eq.CS%MSTAR_RH18) then + MSTAR_ROT = CS%RH18_MST_CN1 * ( 1.0 - ( 1.+CS%RH18_MST_CN2 * & + exp( CS%RH18_MST_CN3 * MLD_GUESS * absf(i) / u_star) )**-1.0 ) + MSTAR_STAB = CS%RH18_MST_CS1 * (bf_stable**2*MLD_GUESS & + / ( u_star**5 * absf(i) ) ) **CS%RH18_MST_CS2 + MSTAR_MIX = MSTAR_ROT + MSTAR_STAB + endif!mstar_mode==1 or ==2 or ==3 ! Adjustment for unstable buoyancy flux. ! Convection reduces mechanical mixing because there ! is less density gradient to mix. (Statically unstable near surface) @@ -901,7 +940,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS mech_TKE_k(i,1) = mech_TKE(i) ; conv_PErel_k(i,1) = conv_PErel(i) nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 endif - + K_Enhancement = 0. !Initialize to zero do K=2,nz ! Apply dissipation to the TKE, here applied as an exponential decay ! due to 3-d turbulent energy being lost to inefficient rotational modes. @@ -1064,13 +1103,27 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dMKE_max = 0.0 ; MKE2_Hharm = 0.0 endif + ! Compute the local enhnacement of K (perhaps due to Langmuir) + if (CS%LT_ENH_K_R16) then + Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 + K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) + K_Enhancement = K_Enhancement * Shape_Function / Max_Shape_Function + endif + ! At this point, Kddt_h(K) will be unknown because its value may depend ! on how much energy is available. mech_TKE might be negative due to ! contributions from TKE_forced. h_tt = htot(i) + h_tt_min TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) if (TKE_here > 0.0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + if (CS%vstar_mode==0) then + vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + elseif (CS%vstar_mode==1) then + Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) + vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & + (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & + Surface_Scale + endif hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) @@ -1082,6 +1135,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) endif + Kd_guess0 = Kd_guess0 * (K_Enhancement+1.) else vstar = 0.0 ; Kd_guess0 = 0.0 endif @@ -1122,7 +1176,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Does MKE_src need to be included in the calculation of vstar here? TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) if (TKE_here > 0.0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + if (CS%vstar_mode==0) then + vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + elseif (CS%vstar_mode==1) then + Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) + vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & + (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & + Surface_Scale + endif hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) @@ -1134,6 +1195,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) endif + Kd(i,k) = Kd(i,k) * (K_Enhancement+1.) else vstar = 0.0 ; Kd(i,k) = 0.0 endif @@ -2045,7 +2107,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "An integer switch for how to compute MSTAR. \n"//& " 0 for constant MSTAR\n"//& " 1 for MSTAR w/ MLD in stabilizing limit\n"//& - " 2 for MSTAR w/ L_E/L_O in stabilizing limit.",& + " 2 for MSTAR w/ L_E/L_O in stabilizing limit\n"//& + " 3 for MSTAR as in RH18.",& "units=nondim",default=0) call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE \n"//& @@ -2086,6 +2149,33 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "Coefficient in computing mstar when only rotation limits \n"//& " the total mixing. (used only if MSTAR_MODE=2)"& ,"units=nondim",default=0.085) + call get_param(param_file, mdl, "RH18_MST_CN1", CS%RH18_MST_CN1,& + "MSTAR_N coefficient 1 (outter-most coefficient for fit). \n"//& + " The value of 0.275 is given in RH18. Increasing this \n"//& + "coefficient increases MSTAR for all values of Hf/ust, but more \n"//& + "effectively at low values (weakly developed OSBLs).",& + units="nondim", default=0.275) + call get_param(param_file, mdl, "RH18_MST_CN2", CS%RH18_MST_CN2,& + "MSTAR_N coefficient 2 (coefficient outside of exponential decay). \n"//& + "The value of 8.0 is given in RH18. Increasing this coefficient \n"//& + "increases MSTAR for all values of HF/ust, with a much more even \n"//& + "effect across a wide range of Hf/ust than CN1.",& + units="nondim",default=8.0) + call get_param(param_file, mdl, "RH18_MST_CN3", CS%RH18_MST_CN3,& + "MSTAR_N coefficient 3 (exponential decay coefficient). \n"//& + "The value of -5.0 is given in RH18. Increasing this increases how \n"//& + "quickly the value of MSTAR decreases as Hf/ust increases.",& + units="nondim",default=-5.0) + call get_param(param_file, mdl, "RH18_MST_CS1", CS%RH18_MST_CS1,& + "MSTAR_S coefficient for RH18 in stabilizing limit. \n"//& + "The value of 0.2 is given in RH18 and increasing it increases \n"//& + "MSTAR in the presence of a stabilizing surface buoyancy flux.",& + units="nondim",default=0.2) + call get_param(param_file, mdl, "RH18_MST_CS2", CS%RH18_MST_CS2,& + "MSTAR_S exponent for RH18 in stabilizing limit. \n"//& + "The value of 0.4 is given in RH18 and increasing it increases MSTAR \n"//& + "exponentially in the presence of a stabilizing surface buoyancy flux.",& + Units="nondim",default=0.4) call get_param(param_file, mdl, "NSTAR", CS%nstar, & "The portion of the buoyant potential energy imparted by \n"//& "surface fluxes that is available to drive entrainment \n"//& @@ -2121,6 +2211,11 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "fraction of the absolute rotation rate blended with the \n"//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) + call get_param(param_file, mdl, "VSTAR_MODE", CS%vstar_mode, & + "An integer switch for how to compute VSTAR. \n"//& + " 0 for old vstar (TKE Remaining)^(1/3)\n"//& + " 1 for vstar from u* and w* (see Reichl & Hallberg 2018).",& + "units=nondim",default=0) call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & "A ratio relating the efficiency with which convectively \n"//& "released energy is converted to a turbulent velocity, \n"// & @@ -2130,6 +2225,16 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "An overall nondimensional scaling factor for v*. \n"// & "Making this larger decreases the PBL diffusivity.", & units="nondim", default=1.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& + "The proportionality times ustar to set vstar to at the surface.",& + "units=nondim", default=1.2) + call get_param(param_file, mdl, "LT_ENHANCE_K_R16",CS%LT_ENH_K_R16, & + "Logical flag to toggle on enhancing mixing coefficient in\n"//& + "boundary layer due to Langmuir turbulence following Reichl\n"//& + "et al., 2016. \n"//& + "This approach is not recommended for use, as it is based\n"//& + "on a hurricane LES configuration and not known if it is general.",& + units="nondim",default=.false.) call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & "A nondimensional scaling factor controlling the inhibition \n"// & "of the diffusive length scale by rotation. Making this larger \n"//& From 3e56a54174b881272844987d610fd1a05ef600a6 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Wed, 22 May 2019 14:54:29 -0400 Subject: [PATCH 070/106] Undo changing default La_depth_ratio from 0.04 to 0.2 --- src/user/MOM_wave_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 044343abc6..65bd236e5a 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -357,7 +357,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & "The depth (normalized by BLD) to average Stokes drift over in \n"//& " Langmuir number calculation, where La = sqrt(ust/Stokes).", & - units="nondim",default=0.2) + units="nondim",default=0.04) call get_param(param_file, mdl, "LA_MISALIGNMENT", LA_Misalignment, & "Flag (logical) if using misalignment bt shear and waves in LA",& default=.false.) From 205a450edead87662ef5769daef1c3a938a9787e Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Wed, 22 May 2019 15:10:18 -0400 Subject: [PATCH 071/106] Moving new ePBL feature Kd_enhance entirely inside of if-block --- .../vertical/MOM_energetic_PBL.F90 | 23 +++++++++++-------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index eb377c336f..0ec3088aa2 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -940,7 +940,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS mech_TKE_k(i,1) = mech_TKE(i) ; conv_PErel_k(i,1) = conv_PErel(i) nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 endif - K_Enhancement = 0. !Initialize to zero do K=2,nz ! Apply dissipation to the TKE, here applied as an exponential decay ! due to 3-d turbulent energy being lost to inefficient rotational modes. @@ -1103,13 +1102,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dMKE_max = 0.0 ; MKE2_Hharm = 0.0 endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - K_Enhancement = K_Enhancement * Shape_Function / Max_Shape_Function - endif - ! At this point, Kddt_h(K) will be unknown because its value may depend ! on how much energy is available. mech_TKE might be negative due to ! contributions from TKE_forced. @@ -1135,7 +1127,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) endif - Kd_guess0 = Kd_guess0 * (K_Enhancement+1.) + Kd_guess0 = Kd_guess0 + ! Compute the local enhnacement of K (perhaps due to Langmuir) + if (CS%LT_ENH_K_R16) then + Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 + K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) + Kd_guess0 = Kd_guess0 * Shape_Function / Max_Shape_Function + endif else vstar = 0.0 ; Kd_guess0 = 0.0 endif @@ -1195,7 +1193,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) endif - Kd(i,k) = Kd(i,k) * (K_Enhancement+1.) + ! Compute the local enhnacement of K (perhaps due to Langmuir) + if (CS%LT_ENH_K_R16) then + Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 + K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) + Kd(i,k) = Kd(i,K) * Shape_Function / Max_Shape_Function + endif else vstar = 0.0 ; Kd(i,k) = 0.0 endif From 80243641dd9f6169175c5c957bd5f89e02336b48 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Wed, 22 May 2019 15:11:49 -0400 Subject: [PATCH 072/106] Clean-up of previous commit --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 0ec3088aa2..937a951773 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1127,7 +1127,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) endif - Kd_guess0 = Kd_guess0 ! Compute the local enhnacement of K (perhaps due to Langmuir) if (CS%LT_ENH_K_R16) then Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 From 413a8492cdb74dd60f0def0ade883c2b4b65301d Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Wed, 22 May 2019 15:16:24 -0400 Subject: [PATCH 073/106] Setting ePBL enhance_K variables to parameters - The values are hard-coded into variable declaration statements and therefore are meant to be declared as parameters. --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 937a951773..1392f4c55c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -526,8 +526,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: K_Enhancement ! A local enhancement of K, perhaps due to Langmuir turbulence ! For LT_ENH_K_R16 real :: Shape_Function ! The shape function of the enhancement - real :: Max_Shape_Function = 0.148148 ! The max value of the shape function of the enhancement - real :: Max_K_Enhancement = 2.25 ! The max value of the enhancement + real, parameter :: Max_Shape_Function = 0.148148 ! The max value of the shape function of the enhancement + real, parameter :: Max_K_Enhancement = 2.25 ! The max value of the enhancement !-End for LT_ENH_K_R16 logical :: debug=.false. ! Change this hard-coded value for debugging. From e15fa882b9feaeca224bc0c22527111eee7e8145 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Fri, 24 May 2019 10:59:19 -0400 Subject: [PATCH 074/106] Fixing bug to WaveMethod inserted in WaveInterface by previous commit. --- src/user/MOM_wave_interface.F90 | 36 ++++++++++++--------------------- 1 file changed, 13 insertions(+), 23 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 044343abc6..eedf51ce29 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -411,34 +411,23 @@ subroutine MOM_wave_interface_init_lite(param_file) character*(5), parameter :: NULL_STRING = "EMPTY" character*(4), parameter :: LF17_STRING = "LF17" character*(13) :: TMPSTRING1 + logical :: StatisticalWaves + ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & "The depth (normalized by BLD) to average Stokes drift over in \n"//& " Langmuir number calculation, where La = sqrt(ust/Stokes).", & units="nondim",default=0.04) - ! Get Wave Method and write to integer WaveMethod - ! At this point only LF17 is a valid choice, since the Waves module isn't initialized. - call get_param(param_file,mdl,"WAVE_METHOD",TMPSTRING1, & - "Choice of wave method, valid options include: \n"// & - " TEST_PROFILE - Prescribed from surface Stokes drift \n"// & - " and a decay wavelength.\n"// & - " SURFACE_BANDS - Computed from multiple surface values \n"// & - " and decay wavelengths.\n"// & - " DHH85 - Uses Donelan et al. 1985 empirical \n"// & - " wave spectrum with prescribed values. \n"// & - " LF17 - Infers Stokes drift profile from wind \n"// & - " speed following Li and Fox-Kemper 2017.\n", & - units='', default=NULL_STRING) - select case (TRIM(TMPSTRING1)) - case (NULL_STRING)! No Waves - WaveMethod = NULL_WaveMethod - case (LF17_STRING)!Li and Fox-Kemper 17 wind-sea Langmuir number + ! Check if using LA_LI2016 + call get_param(param_file,mdl,"USE_LA_LI2016",StatisticalWaves, & + do_not_log=.true.,default=.false.) + if (StatisticalWaves) then WaveMethod = LF17 PI=4.0*atan(1.0) - case default + else WaveMethod = NULL_WaveMethod - end select + end if return end subroutine MOM_wave_interface_init_lite @@ -969,10 +958,11 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (WaveMethod==LF17) then call get_StokesSL_LiFoxKemper(ustar, hbl*LA_FracHBL, GV, US, LA_STK, LA) - else - LA_STK = 0.0 - LA = 1.e8 - return + elseif (WaveMethod==Null_WaveMethod) then + call MOM_error(FATAL, "Get_Langmuir_number called without defining a WaveMethod. "//& + "Suggest to make sure USE_LT is set/overridden to False or "//& + "choose a wave method (or set USE_LA_LI2016 to use statistical "//& + "waves.") endif if (.not.(WaveMethod==LF17)) then From 1d06bd1b3adfbbf1bfdf45572ec37916cc7f7bac Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Fri, 24 May 2019 13:59:48 -0400 Subject: [PATCH 075/106] Renaming Elizabeth tracer and sponge to RGC --- .../MOM_state_initialization.F90 | 6 +- src/tracer/MOM_tracer_flow_control.F90 | 39 +++++------ .../{Elizabeth_tracer.F90 => RGC_tracer.F90} | 66 +++++++++---------- ...tialization.F90 => RGC_initialization.F90} | 22 +++---- 4 files changed, 67 insertions(+), 66 deletions(-) rename src/tracer/{Elizabeth_tracer.F90 => RGC_tracer.F90} (90%) rename src/user/{Elizabeth_initialization.F90 => RGC_initialization.F90} (94%) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 5523b48057..7c7b0617a7 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -51,7 +51,7 @@ module MOM_state_initialization use ISOMIP_initialization, only : ISOMIP_initialize_thickness use ISOMIP_initialization, only : ISOMIP_initialize_sponges use ISOMIP_initialization, only : ISOMIP_initialize_temperature_salinity -use Elizabeth_initialization, only : Elizabeth_initialize_sponges +use RGC_initialization, only : RGC_initialize_sponges use baroclinic_zone_initialization, only : baroclinic_zone_init_temperature_salinity use benchmark_initialization, only : benchmark_initialize_thickness use benchmark_initialization, only : benchmark_init_temperature_salinity @@ -514,7 +514,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t file - read sponge properties from the file \n"//& " \t\t specified by (SPONGE_FILE).\n"//& " \t ISOMIP - apply ale sponge in the ISOMIP case \n"//& - " \t Elizabeth - apply sponge in the Elizabeth case \n"//& + " \t RGC - apply sponge in the rotating_gravity_current case \n"//& " \t DOME - use a slope and channel configuration for the \n"//& " \t\t DOME sill-overflow test case. \n"//& " \t BFB - Sponge at the southern boundary of the domain\n"//& @@ -526,7 +526,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case("Elizabeth"); call Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, useALE, & + case("RGC"); call RGC_initialize_sponges(G, GV, tv, u, v, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, use_temperature, tv, & PF, sponge_CSp, h) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index bd61e4f52c..d3d5b61cff 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -30,9 +30,9 @@ module MOM_tracer_flow_control use ISOMIP_tracer, only : register_ISOMIP_tracer, initialize_ISOMIP_tracer use ISOMIP_tracer, only : ISOMIP_tracer_column_physics, ISOMIP_tracer_surface_state use ISOMIP_tracer, only : ISOMIP_tracer_end, ISOMIP_tracer_CS -use Elizabeth_tracer, only : register_Elizabeth_tracer, initialize_Elizabeth_tracer -use Elizabeth_tracer, only : Elizabeth_tracer_column_physics -use Elizabeth_tracer, only : Elizabeth_tracer_end, Elizabeth_tracer_CS +use RGC_tracer, only : register_RGC_tracer, initialize_RGC_tracer +use RGC_tracer, only : RGC_tracer_column_physics +use RGC_tracer, only : RGC_tracer_end, RGC_tracer_CS use ideal_age_example, only : register_ideal_age_tracer, initialize_ideal_age_tracer use ideal_age_example, only : ideal_age_tracer_column_physics, ideal_age_tracer_surface_state use ideal_age_example, only : ideal_age_stock, ideal_age_example_end, ideal_age_tracer_CS @@ -76,7 +76,7 @@ module MOM_tracer_flow_control logical :: use_USER_tracer_example = .false. !< If true, use the USER_tracer_example package logical :: use_DOME_tracer = .false. !< If true, use the DOME_tracer package logical :: use_ISOMIP_tracer = .false. !< If true, use the ISOMPE_tracer package - logical :: use_Elizabeth_tracer =.false. !< If true, use the Elizabeth_tracer package + logical :: use_RGC_tracer =.false. !< If true, use the RGC_tracer package logical :: use_ideal_age = .false. !< If true, use the ideal age tracer package logical :: use_regional_dyes = .false. !< If true, use the regional dyes tracer package logical :: use_oil = .false. !< If true, use the oil tracer package @@ -90,7 +90,7 @@ module MOM_tracer_flow_control type(USER_tracer_example_CS), pointer :: USER_tracer_example_CSp => NULL() type(DOME_tracer_CS), pointer :: DOME_tracer_CSp => NULL() type(ISOMIP_tracer_CS), pointer :: ISOMIP_tracer_CSp => NULL() - type(Elizabeth_tracer_CS), pointer :: Elizabeth_tracer_CSp => NULL() + type(RGC_tracer_CS), pointer :: RGC_tracer_CSp => NULL() type(ideal_age_tracer_CS), pointer :: ideal_age_tracer_CSp => NULL() type(dye_tracer_CS), pointer :: dye_tracer_CSp => NULL() type(oil_tracer_CS), pointer :: oil_tracer_CSp => NULL() @@ -190,8 +190,8 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "USE_ISOMIP_TRACER", CS%use_ISOMIP_tracer, & "If true, use the ISOMIP_tracer tracer package.", & default=.false.) - call get_param(param_file, mdl, "USE_ELIZABETH_TRACER", CS%use_Elizabeth_tracer, & - "If true, use the Elizabeth_tracer tracer package.", & + call get_param(param_file, mdl, "USE_RGC_TRACER", CS%use_RGC_tracer, & + "If true, use the RGC_tracer tracer package.", & default=.false.) call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", CS%use_ideal_age, & "If true, use the ideal_age_example tracer package.", & @@ -241,8 +241,8 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) if (CS%use_ISOMIP_tracer) CS%use_ISOMIP_tracer = & register_ISOMIP_tracer(HI, GV, param_file, CS%ISOMIP_tracer_CSp, & tr_Reg, restart_CS) - if (CS%use_Elizabeth_tracer) CS%use_Elizabeth_tracer = & - register_Elizabeth_tracer(HI, GV, param_file, CS%Elizabeth_tracer_CSp, & + if (CS%use_RGC_tracer) CS%use_RGC_tracer = & + register_RGC_tracer(HI, GV, param_file, CS%RGC_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_ideal_age) CS%use_ideal_age = & register_ideal_age_tracer(HI, GV, param_file, CS%ideal_age_tracer_CSp, & @@ -324,9 +324,9 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB if (CS%use_ISOMIP_tracer) & call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, & ALE_sponge_CSp, diag_to_Z_CSp) - if (CS%use_Elizabeth_tracer) & - call initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, & - CS%Elizabeth_tracer_CSp, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp) + if (CS%use_RGC_tracer) & + call initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, & + CS%RGC_tracer_CSp, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp) if (CS%use_ideal_age) & call initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS%ideal_age_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) @@ -507,9 +507,9 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, CS%ISOMIP_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) - if (CS%use_Elizabeth_tracer) & - call Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%Elizabeth_tracer_CSp, & + if (CS%use_RGC_tracer) & + call RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & + G, GV, CS%RGC_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) if (CS%use_ideal_age) & @@ -572,9 +572,9 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (CS%use_ISOMIP_tracer) & call ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, CS%ISOMIP_tracer_CSp) - if (CS%use_Elizabeth_tracer) & - call Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%Elizabeth_tracer_CSp) + if (CS%use_RGC_tracer) & + call RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & + G, GV, CS%RGC_tracer_CSp) if (CS%use_ideal_age) & call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, CS%ideal_age_tracer_CSp) @@ -867,7 +867,7 @@ subroutine tracer_flow_control_end(CS) call USER_tracer_example_end(CS%USER_tracer_example_CSp) if (CS%use_DOME_tracer) call DOME_tracer_end(CS%DOME_tracer_CSp) if (CS%use_ISOMIP_tracer) call ISOMIP_tracer_end(CS%ISOMIP_tracer_CSp) - if (CS%use_Elizabeth_tracer) call Elizabeth_tracer_end(CS%Elizabeth_tracer_CSp) + if (CS%use_RGC_tracer) call RGC_tracer_end(CS%RGC_tracer_CSp) if (CS%use_ideal_age) call ideal_age_example_end(CS%ideal_age_tracer_CSp) if (CS%use_regional_dyes) call regional_dyes_end(CS%dye_tracer_CSp) if (CS%use_oil) call oil_tracer_end(CS%oil_tracer_CSp) @@ -886,6 +886,7 @@ end subroutine tracer_flow_control_end !> \namespace MOM_tracer_flow_control !! !! By Will Cooke, April 2003 +!! Edited by Elizabeth Yankovsky, May 2019 !! !! This module contains two subroutines into which calls to other !! tracer initialization (call_tracer_init_fns) and column physics diff --git a/src/tracer/Elizabeth_tracer.F90 b/src/tracer/RGC_tracer.F90 similarity index 90% rename from src/tracer/Elizabeth_tracer.F90 rename to src/tracer/RGC_tracer.F90 index 36b40d62e2..d07d5f45f9 100644 --- a/src/tracer/Elizabeth_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -2,17 +2,17 @@ !! dynamically passive tracers. For now, three passive tracers can be injected in !! the domain !! Set up and use passive tracers requires the following: -!! (1) register_Elizabeth_tracer +!! (1) register_RGC_tracer !! (2) apply diffusion, physics/chemistry and advect the tracer !********+*********+*********+*********+*********+*********+*********+** !* * !* By Robert Hallberg, 2002 * !* Adapted to the IDEAL_IS test case by Gustavo Marques, Oct 2016 -!* Edited by Elizabeth Yankovsky, May 2018 * +!* Adapted for the rotating_gravity_current case by Elizabeth Yankovsky, May 2018 * !*********+*********+*********+*********+*********+*********+*********** -module Elizabeth_tracer +module RGC_tracer ! This file is part of MOM6. See LICENSE.md for the license. @@ -41,8 +41,8 @@ module Elizabeth_tracer #include !< Publicly available functions -public register_Elizabeth_tracer, initialize_Elizabeth_tracer -public Elizabeth_tracer_column_physics, Elizabeth_tracer_end +public register_RGC_tracer, initialize_RGC_tracer +public RGC_tracer_column_physics, RGC_tracer_end !< ntr is the number of tracers in this module. integer, parameter :: NTR = 1 @@ -52,7 +52,7 @@ module Elizabeth_tracer end type p3d !> tracer control structure -type, public :: Elizabeth_tracer_CS ; private +type, public :: RGC_tracer_CS ; private logical :: coupled_tracers = .false. !< These tracers are not offered to the !< coupler. character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " " @@ -82,32 +82,32 @@ module Elizabeth_tracer integer, dimension(NTR) :: id_tr_dfx = -1, id_tr_dfy = -1 type(vardesc) :: tr_desc(NTR) -end type Elizabeth_tracer_CS +end type RGC_tracer_CS contains !> This subroutine is used to register tracer fields -function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) +function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI ! NULL() - logical :: register_Elizabeth_tracer + logical :: register_RGC_tracer integer :: isd, ied, jsd, jed, nz, m isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke if (associated(CS)) then - call MOM_error(WARNING, "Elizabeth_register_tracer called with an "// & + call MOM_error(WARNING, "RGC_register_tracer called with an "// & "associated control structure.") return endif @@ -115,15 +115,15 @@ function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "Elizabeth_TRACER_IC_FILE", CS%tracer_IC_file, & + call get_param(param_file, mdl, "RGC_TRACER_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial \n"//& - "conditions for the Elizabeth tracers, or blank to initialize \n"//& + "conditions for the RGC tracers, or blank to initialize \n"//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) CS%tracer_IC_file = trim(inputdir)//trim(CS%tracer_IC_file) - call log_param(param_file, mdl, "INPUTDIR/Elizabeth_TRACER_IC_FILE", & + call log_param(param_file, mdl, "INPUTDIR/RGC_TRACER_IC_FILE", & CS%tracer_IC_file) endif call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & @@ -155,7 +155,7 @@ function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) do m=1,NTR if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif - write(longname,'("Concentration of Elizabeth Tracer ",I2.2)') m + write(longname,'("Concentration of RGC Tracer ",I2.2)') m CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) ! This is needed to force the compiler not to do a copy in the registration @@ -171,12 +171,12 @@ function register_Elizabeth_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) enddo CS%tr_Reg => tr_Reg - register_Elizabeth_tracer = .true. -end function register_Elizabeth_tracer + register_RGC_tracer = .true. +end function register_RGC_tracer !> Initializes the NTR tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. -subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & layer_CSp, sponge_CSp, diag_to_Z_CSp) type(ocean_grid_type), intent(in) :: G !< Grid structure. @@ -186,7 +186,7 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(diag_ctrl), target, intent(in) :: diag type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. - type(Elizabeth_tracer_CS), pointer :: CS !< The control structure returned by a previous call to Elizabeth_register_tracer. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call to RGC_register_tracer. type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure for diagnostics in depth space. @@ -226,10 +226,10 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (len_trim(CS%tracer_IC_file) >= 1) then ! Read the tracer concentrations from a netcdf file. if (.not.file_exists(CS%tracer_IC_file, G%Domain)) & - call MOM_error(FATAL, "Elizabeth_initialize_tracer: Unable to open "// & + call MOM_error(FATAL, "RGC_initialize_tracer: Unable to open "// & CS%tracer_IC_file) do m=1,NTR - call query_vardesc(CS%tr_desc(m), name, caller="initialize_Elizabeth_tracer") + call query_vardesc(CS%tr_desc(m), name, caller="initialize_RGC_tracer") call read_data(CS%tracer_IC_file, trim(name), & CS%tr(:,:,:,m), domain=G%Domain%mpp_domain) enddo @@ -289,7 +289,7 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & endif ! endif !Layer mode else - call MOM_error(FATAL, "Elizabeth_initialize_tracer: "// & + call MOM_error(FATAL, "RGC_initialize_tracer: "// & "The pointer to sponge_CSp must be associated if SPONGE is defined.") endif !selecting mode/calling error if no pointer endif !using sponge @@ -301,24 +301,24 @@ subroutine initialize_Elizabeth_tracer(restart, day, G, GV, h, diag, OBC, CS, & do m=1,NTR ! Register the tracer for the restart file. call query_vardesc(CS%tr_desc(m), name, units=units, longname=longname, & - caller="initialize_Elizabeth_tracer") + caller="initialize_RGC_tracer") call register_Z_tracer(CS%tr(:,:,:,m), trim(name), longname, units, & day, G, diag_to_Z_CSp) enddo -end subroutine initialize_Elizabeth_tracer +end subroutine initialize_RGC_tracer !> This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. -subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & +subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & aggregate_FW_forcing, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G type(verticalGrid_type), intent(in) :: GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb type(forcing), intent(in) :: fluxes real, intent(in) :: dt - type(Elizabeth_tracer_CS), pointer :: CS + type(RGC_tracer_CS), pointer :: CS logical, optional,intent(in) :: aggregate_FW_forcing real, optional,intent(in) :: evap_CFL_limit real, optional,intent(in) :: minimum_forcing_depth @@ -337,7 +337,7 @@ subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. ! (in) CS - The control structure returned by a previous call to -! Elizabeth_register_tracer. +! RGC_register_tracer. ! ! 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] @@ -411,10 +411,10 @@ subroutine Elizabeth_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G call post_data(CS%id_tr_dfy(m),CS%tr_dfy(m)%p(:,:,:),CS%diag) enddo -end subroutine Elizabeth_tracer_column_physics +end subroutine RGC_tracer_column_physics -subroutine Elizabeth_tracer_end(CS) - type(Elizabeth_tracer_CS), pointer :: CS +subroutine RGC_tracer_end(CS) + type(RGC_tracer_CS), pointer :: CS integer :: m if (associated(CS)) then @@ -429,6 +429,6 @@ subroutine Elizabeth_tracer_end(CS) deallocate(CS) endif -end subroutine Elizabeth_tracer_end +end subroutine RGC_tracer_end -end module Elizabeth_tracer +end module RGC_tracer diff --git a/src/user/Elizabeth_initialization.F90 b/src/user/RGC_initialization.F90 similarity index 94% rename from src/user/Elizabeth_initialization.F90 rename to src/user/RGC_initialization.F90 index 6c984a687d..0f33727e3b 100644 --- a/src/user/Elizabeth_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -1,4 +1,4 @@ -module Elizabeth_initialization +module RGC_initialization !*********************************************************************** !* GNU General Public License * !* This file is a part of MOM. * @@ -46,12 +46,12 @@ module Elizabeth_initialization ! Private (module-wise) parameters ! ----------------------------------------------------------------------------- -character(len=40) :: mod = "Elizabeth_initialization" ! This module's name. +character(len=40) :: mod = "RGC_initialization" ! This module's name. ! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world ! ----------------------------------------------------------------------------- -public Elizabeth_initialize_sponges +public RGC_initialize_sponges ! ----------------------------------------------------------------------------- ! This module contains the following routines @@ -61,7 +61,7 @@ module Elizabeth_initialization !> Sets up the 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. -subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) +subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers @@ -103,7 +103,7 @@ subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) character(len=40) :: filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir, h_var - character(len=40) :: mod = "Elizabeth_initialize_sponges" ! This subroutine's name. + character(len=40) :: mod = "RGC_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, iscB, iecB, jscB, jecB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -136,9 +136,9 @@ subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) "The minimum depth of the ocean.", units="m", default=0.0) if (associated(CSp)) call MOM_error(FATAL, & - "Elizabeth_initialize_sponges called with an associated control structure.") + "RGC_initialize_sponges called with an associated control structure.") if (associated(ACSp)) call MOM_error(FATAL, & - "Elizabeth_initialize_sponges called with an associated ALE-sponge control structure.") + "RGC_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! @@ -195,7 +195,7 @@ subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) !read temp and eta filename = trim(inputdir)//trim(state_file) if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " Elizabeth_initialize_sponges: Unable to open "//trim(filename)) + call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) @@ -250,9 +250,9 @@ subroutine Elizabeth_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) endif -end subroutine Elizabeth_initialize_sponges +end subroutine RGC_initialize_sponges -!> \class Elizabeth_initialization +!> \class RGC_initialization !! !! The module configures the ISOMIP test case. -end module Elizabeth_initialization +end module RGC_initialization From 99d7252876ec2fb9175b01d7accdf8bccc92cfdd Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Thu, 30 May 2019 11:23:04 -0400 Subject: [PATCH 076/106] Adding changes to RGC --- src/tracer/RGC_tracer.F90 | 6 +----- src/user/RGC_initialization.F90 | 2 +- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 214f2fabf4..df08906174 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -371,11 +371,7 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, if (CS%mask_tracers) then do m = 1,NTR ; if (CS%id_tracer(m) > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - if (h_new(i,j,k) < 1.1*GV%Angstrom) then - CS%tr_aux(i,j,k,m) = CS%land_val(m) - else - CS%tr_aux(i,j,k,m) = CS%tr(i,j,k,m) - endif + CS%tr_aux(i,j,k,m) = CS%tr(i,j,k,m) enddo ; enddo ; enddo endif ; enddo endif diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 0f33727e3b..57b9dfb1c4 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -228,7 +228,7 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! Set the inverse 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) + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) if ( GV%nkml>0 ) then ! This call to set_up_sponge_ML_density registers the target values of the From 71b02d7a27dcb4900ac4b507dd2371a6ac91a2d9 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 30 May 2019 11:19:42 -0400 Subject: [PATCH 077/106] +(*) u,v tendendy diagnostic fix Recent testing showed a difference in the time derivative diagnostics dudt, dvdt, dhdt for symmetric and non-symmetric grids. The issue appears to be be due to assumed 1-indexing within the `register_time_deriv` functions of MOM_diagnostics, due to use of pointers without explicit start index. This was causing an error in `calculate_derivs`, which assume standard grid indexing. There was no error in non-symmetric mode, which assumes 1-indexing (when global indexing is disabled, as default), but was creating off-by-one errors in symmetric mode for the u and v time derivaties, which typically start at 0 for the x and y axes, respectively. The dhdt diagnostic was unaffected, since h-points always use 1-indexing. This also affected the dKE/dt diagnostic, since they used dudt and dvdt. We resolve this by introducing a lower bound input argument to `register_time_deriv` and use this to define the start index for the various p3d pointers. This is a minor API change which only affects the dudt, dvdt, and dhdt diagnostics, and may change the dudt and dvdt symmetric grid diagnostics. --- src/diagnostics/MOM_diagnostics.F90 | 33 +++++++++++++++++------------ 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 01cc707de9..7558311795 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1076,16 +1076,21 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) end subroutine calculate_energy_diagnostics !> This subroutine registers fields to calculate a diagnostic time derivative. -subroutine register_time_deriv(f_ptr, deriv_ptr, CS) - real, dimension(:,:,:), target :: f_ptr !< Field whose derivative is taken. - real, dimension(:,:,:), target :: deriv_ptr !< Field in which the calculated time derivatives - !! will be placed. +subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) + integer, intent(in), dimension(3) :: lb !< Lower index bound of f_ptr + real, dimension(lb(1):,lb(2):,:), target :: f_ptr + !< Time derivative operand + 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 !! diagnostics_init. ! This subroutine registers fields to calculate a diagnostic time derivative. + ! NOTE: Lower bound is required for grid indexing in calculate_derivs(). + ! We assume that the vertical axis is 1-indexed. - integer :: m + 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.") @@ -1098,9 +1103,11 @@ subroutine register_time_deriv(f_ptr, deriv_ptr, CS) m = CS%num_time_deriv+1 ; CS%num_time_deriv = m - CS%nlay(m) = size(f_ptr(:,:,:),3) + ub(:) = lb(:) + shape(f_ptr) - 1 + + CS%nlay(m) = size(f_ptr, 3) CS%deriv(m)%p => deriv_ptr - allocate(CS%prev_val(m)%p(size(f_ptr(:,:,:),1), size(f_ptr(:,:,:),2), CS%nlay(m)) ) + allocate(CS%prev_val(m)%p(lb(1):ub(1), lb(2):ub(2), CS%nlay(m))) CS%var_ptr(m)%p => f_ptr CS%prev_val(m)%p(:,:,:) = f_ptr(:,:,:) @@ -1551,21 +1558,21 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'Zonal Acceleration', 'm s-2') 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) - call register_time_deriv(MIS%u, CS%du_dt, CS) + 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') 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) - call register_time_deriv(MIS%v, CS%dv_dt, CS) + 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", 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) - call register_time_deriv(MIS%h, CS%dh_dt, CS) + call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif ! layer thickness variables @@ -2009,15 +2016,15 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) 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) - call register_time_deriv(MIS%u, CS%du_dt, CS) + 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) - call register_time_deriv(MIS%v, CS%dv_dt, CS) + 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) - call register_time_deriv(MIS%h, CS%dh_dt, CS) + call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif endif From 056b05cdf6ad2cea6cd168727e9405538f54fbd5 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 30 May 2019 13:59:38 -0400 Subject: [PATCH 078/106] (*) speed diagnostic fix on nonsymmetric grids The speed diagnostic currently requires an interpolation of u and v onto the h-points. On non-symmetric grids, this was causing an error on the west and south boundaries, since the compute loops in `extract_surface_state` did not update the boundaries, which are used in the speed calculation. We resolve this by extending the loops from G%IscB, which only includes the boundary on symmetric grids, to isc-1, which always include the boundaries. This assumes a nonzero halo, and that the halos of u and v have been updated. --- src/core/MOM.F90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 682f7df322..de7f01421d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2748,10 +2748,10 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%SST(i,j) = CS%tv%T(i,j,1) sfc_state%SSS(i,j) = CS%tv%S(i,j,1) enddo ; enddo ; endif - do j=js,je ; do I=IscB,IecB + do j=js,je ; do I=is-1,ie sfc_state%u(I,j) = u(I,j,1) enddo ; enddo - do J=JscB,JecB ; do i=is,ie + do J=js-1,je ; do i=is,ie sfc_state%v(i,J) = v(i,J,1) enddo ; enddo @@ -2803,12 +2803,15 @@ subroutine extract_surface_state(CS, sfc_state) enddo ! end of j loop ! Determine the mean velocities in the uppermost depth_ml fluid. + ! NOTE: Velocity loops start on `[ij]s-1` in order to update halo values + ! required by the speed diagnostic on the non-symmetric grid. + ! This assumes that u and v halos have already been updated. if (CS%Hmix_UV>0.) then !### This calculation should work in thickness (H) units instead of Z, but that !### would change answers at roundoff in non-Boussinesq cases. depth_ml = CS%Hmix_UV !$OMP parallel do default(shared) private(depth,dh,hv) - do J=jscB,jecB + do J=js-1,ie do i=is,ie depth(i) = 0.0 sfc_state%v(i,J) = 0.0 @@ -2835,11 +2838,11 @@ subroutine extract_surface_state(CS, sfc_state) !$OMP parallel do default(shared) private(depth,dh,hu) do j=js,je - do I=iscB,iecB + do I=is-1,ie depth(I) = 0.0 sfc_state%u(I,j) = 0.0 enddo - do k=1,nz ; do I=iscB,iecB + do k=1,nz ; do I=is-1,ie hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_Z if (depth(i) + hu < depth_ml) then dh = hu @@ -2852,17 +2855,17 @@ subroutine extract_surface_state(CS, sfc_state) depth(I) = depth(I) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. - do I=iscB,iecB + do I=is-1,ie if (depth(I) < GV%H_subroundoff*GV%H_to_Z) & depth(I) = GV%H_subroundoff*GV%H_to_Z sfc_state%u(I,j) = sfc_state%u(I,j) / depth(I) enddo enddo ! end of j loop else ! Hmix_UV<=0. - do j=js,je ; do I=IscB,IecB + do j=js,je ; do I=is-1,ie sfc_state%u(I,j) = u(I,j,1) enddo ; enddo - do J=JscB,JecB ; do i=is,ie + do J=js-1,je ; do i=is,ie sfc_state%v(i,J) = v(i,J,1) enddo ; enddo endif From 585a50063431837ca667f6fdea35e9b2767bfea3 Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Tue, 4 Jun 2019 16:17:45 -0400 Subject: [PATCH 079/106] Edited RGC_tracer.F90 --- src/tracer/RGC_tracer.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index df08906174..af8d94b1ca 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -59,9 +59,9 @@ module RGC_tracer type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this - !< subroutine, in g m-3? + !< subroutine real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration - !< for output, in g m-3. + !< for output type(p3d), dimension(NTR) :: & tr_adx, &!< Tracer zonal advective fluxes in g m-3 m3 s-1. tr_ady, &!< Tracer meridional advective fluxes in g m-3 m3 s-1. @@ -152,8 +152,8 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) endif do m=1,NTR - if (m < 10) then ; write(name,'("tr_D",I1.1)') m - else ; write(name,'("tr_D",I2.2)') m ; endif + if (m < 10) then ; write(name,'("tr_RGC",I1.1)') m + else ; write(name,'("tr_RGC",I2.2)') m ; endif write(longname,'("Concentration of RGC Tracer ",I2.2)') m CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) @@ -161,7 +161,7 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! calls. Curses on the designers and implementers of Fortran90. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for the restart file. - call register_restart_field(tr_ptr, CS%tr_desc(m), .true., restart_CS) + !call register_restart_field(tr_ptr, CS%tr_desc(m), .true., restart_CS) ! Register the tracer for horizontal advection & diffusion. call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & name=name, longname=longname, units="kg kg-1", & @@ -292,7 +292,6 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & endif !selecting mode/calling error if no pointer endif !using sponge - end subroutine initialize_RGC_tracer !> This subroutine applies diapycnal diffusion and any other column From e9f95e41272c8d0a3ae9281335389f0114cfe6a5 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 4 Jun 2019 17:02:03 -0400 Subject: [PATCH 080/106] dKEdt diagnostic nonsymmetric bugfix This patch fixes a minor error in the d(KE)/dt diagnostic, specifically any values on the western and southern boundaries (per PE domain). d(KE)/dt depends on the dudt and dvdt diagnostics. However, the western and southern boundaries of these two diagnostics were not updated inside `calculate_derivs`, which caused an error on the western and southern boundaries of d(KE)/dt since it requires an interpolation of dudt and dvdt onto h-points. This was not an issue in symmetric grids, since the west/south values would have been included in the update, but were not updated in non-symmetric mode. We resolve this by extending the loops to update an additional grid point to the west/south. This slightly increases the computation, and assumes an updated halo, but this change has restored consistency of d(KE)/dt in symmetric and nonsymmetric mode. --- src/diagnostics/MOM_diagnostics.F90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7558311795..5da7a91e17 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1128,8 +1128,17 @@ subroutine calculate_derivs(dt, G, CS) if (dt > 0.0) then ; Idt = 1.0/dt else ; return ; endif + ! Because the field is unknown, its grid index bounds are also unknown. + ! Additionally, two of the fields (dudt, dvdt) require calculation of spatial + ! derivatives when computing d(KE)/dt. This raises issues in non-symmetric + ! mode, where the symmetric boundaries (west, south) may not be updated. + + ! For this reason, we explicitly loop from isc-1:iec and jsc-1:jec, in order + ! to force boundary value updates, even though it may not be strictly valid + ! for all fields. Note this assumes a halo, and that it has been updated. + do m=1,CS%num_time_deriv - do k=1,CS%nlay(m) ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + do k=1,CS%nlay(m) ; do j=G%jsc-1,G%jec ; do i=G%isc-1,G%iec CS%deriv(m)%p(i,j,k) = (CS%var_ptr(m)%p(i,j,k) - CS%prev_val(m)%p(i,j,k)) * Idt CS%prev_val(m)%p(i,j,k) = CS%var_ptr(m)%p(i,j,k) enddo ; enddo ; enddo From 94bc51bb1e8993dc5a8cab9b612e1c2d19c67b45 Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Fri, 7 Jun 2019 11:51:36 -0400 Subject: [PATCH 081/106] Updating RGC codes --- src/tracer/RGC_tracer.F90 | 8 ++------ src/user/RGC_initialization.F90 | 4 +--- 2 files changed, 3 insertions(+), 9 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index af8d94b1ca..d75a12413f 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -7,9 +7,7 @@ !********+*********+*********+*********+*********+*********+*********+** !* * -!* By Robert Hallberg, 2002 * -!* Adapted to the IDEAL_IS test case by Gustavo Marques, Oct 2016 -!* Adapted for the rotating_gravity_current case by Elizabeth Yankovsky, May 2018 * +!* By Elizabeth Yankovsky, May 2018 * !*********+*********+*********+*********+*********+*********+*********** module RGC_tracer @@ -158,10 +156,8 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) ! This is needed to force the compiler not to do a copy in the registration - ! calls. Curses on the designers and implementers of Fortran90. + ! calls. tr_ptr => CS%tr(:,:,:,m) - ! Register the tracer for the restart file. - !call register_restart_field(tr_ptr, CS%tr_desc(m), .true., restart_CS) ! Register the tracer for horizontal advection & diffusion. call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & name=name, longname=longname, units="kg kg-1", & diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 57b9dfb1c4..11b61f8d69 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -17,6 +17,7 @@ module RGC_initialization !* write to: Free Software Foundation, Inc., * !* 675 Mass Ave, Cambridge, MA 02139, USA. * !* or see: http://www.gnu.org/licenses/gpl.html * +!* By Elizabeth Yankovsky, May 2018 * !*********************************************************************** use MOM_ALE_sponge, only : ALE_sponge_CS, set_up_ALE_sponge_field, initialize_ALE_sponge @@ -252,7 +253,4 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) end subroutine RGC_initialize_sponges -!> \class RGC_initialization -!! -!! The module configures the ISOMIP test case. end module RGC_initialization From 5b81da976d8d563833dacf56cf0d45be58b8be20 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 10 Jun 2019 09:12:58 -0400 Subject: [PATCH 082/106] (*) Vertical diagnostic remap symmetric bugfix This patch fixes an error in the vertial diagnostic remapping on symmetric grids. The following functions associated with vertical remapping assume grid-based indexing, but receive arrays with 1-based indexing: * diag_remap_do_remap * vertically_reintegrate_diag_field * vertically_interpolate_diag_field Since the calculations typically include a mix of grid-based and 1-based indexing, we retain the grid index loops but introduce 1-based indices, i1 and j1, when addressing these arrays. Note that while the symmetric grid u- and v-points are now defined relative to the global grid (G%isg, G%jsg), we still assume that the h-points are locally 1-based. This is currently true in MOM6 but may require modification if we move to global grid indexing. We have included a very verbose explanation for the gridding issue, in case it ever gets addressed in the future. Symmetric grid results now match non-symmetric grid results, and non-symmetric grid results are unchanged. Model state and dynamics are unaffected by this change and should be bitwise reproducible. --- src/framework/MOM_diag_remap.F90 | 134 ++++++++++++++++++++++++------- 1 file changed, 103 insertions(+), 31 deletions(-) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 632258d5d2..d62c0fe324 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -14,6 +14,45 @@ !! 5. diag_remap_do_remap() is called from within a diag post() to do the remapping before !! the diagnostic is written out. + +! NOTE: In the following functions, the fields are passed using 1-based +! indexing, which requires special handling within the grid index loops. +! +! * diag_remap_do_remap +! * vertically_reintegrate_diag_field +! * vertically_interpolate_diag_field +! * horizontally_average_diag_field +! +! Symmetric grids add an additional row of western and southern points to u- +! and v-grids. Non-symmetric grids are 1-based and symmetric grids are +! zero-based, allowing the same expressions to be used when accessing the +! fields. But if u- or v-points become 1-indexed, as in these functions, then +! the stencils must be re-assessed. +! +! For interpolation between h and u grids, we use the following relations: +! +! h->u: f_u[ig] = 0.5 * (f_h[ ig ] + f_h[ig+1]) +! f_u[i1] = 0.5 * (f_h[i1-1] + f_h[ i1 ]) +! +! u->h: f_h[ig] = 0.5 * (f_u[ig-1] + f_u[ ig ]) +! f_h[i1] = 0.5 * (f_u[ i1 ] + f_u[i1+1]) +! +! where ig is the grid index and i1 is the 1-based index. That is, a 1-based +! u-point is ahead of its matching h-point in non-symmetric mode, but behind +! its matching h-point in non-symmetric mode. +! +! We can combine these expressions by applying to ig a -1 shift on u-grids and +! a +1 shift on h-grids in symmetric mode. +! +! We do not adjust the h-point indices, since they are assumed to be 1-based. +! This is only correct when global indexing is disabled. If global indexing is +! enabled, then all indices will need to be defined relative to the data +! domain. +! +! Finally, note that the mask input fields are pointers to arrays which are +! zero-indexed, and do not need any corrections over grid index loops. + + module MOM_diag_remap ! This file is part of MOM6. See LICENSE.md for the license. @@ -313,7 +352,10 @@ subroutine diag_remap_do_remap(remap_cs, G, GV, h, staggered_in_x, staggered_in_ real, dimension(size(h,3)) :: h_src real :: h_neglect, h_neglect_edge integer :: nz_src, nz_dest - integer :: i, j, k + integer :: i, j, k !< Grid index + integer :: i1, j1 !< 1-based index + integer :: i_lo, i_hi, j_lo, j_hi !< (uv->h) interpolation indices + integer :: shift !< Symmetric offset for 1-based indexing call assert(remap_cs%initialized, 'diag_remap_do_remap: remap_cs not initialized.') call assert(size(field, 3) == size(h, 3), & @@ -330,31 +372,40 @@ subroutine diag_remap_do_remap(remap_cs, G, GV, h, staggered_in_x, staggered_in_ nz_dest = remap_cs%nz remapped_field(:,:,:) = 0. + ! Symmetric grid offset under 1-based indexing; see header for details. + shift = 0; if (G%symmetric) shift = 1 + if (staggered_in_x .and. .not. staggered_in_y) then ! U-points do j=G%jsc, G%jec do I=G%iscB, G%iecB + i1 = i - G%isdB + 1 + i_lo = i1 - shift; i_hi = i_lo + 1 if (associated(mask)) then if (mask(i,j,1) == 0.) cycle endif - h_src(:) = 0.5 * (h(i,j,:) + h(i+1,j,:)) - h_dest(:) = 0.5 * (remap_cs%h(i,j,:) + remap_cs%h(i+1,j,:)) - call remapping_core_h(remap_cs%remap_cs, nz_src, h_src(:), field(I,j,:), & - nz_dest, h_dest(:), remapped_field(I,j,:), & + h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) + h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) + call remapping_core_h(remap_cs%remap_cs, & + nz_src, h_src(:), field(I1,j,:), & + nz_dest, h_dest(:), remapped_field(I1,j,:), & h_neglect, h_neglect_edge) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then ! V-points do J=G%jscB, G%jecB + j1 = j - G%jsdB + 1 + j_lo = j1 - shift; j_hi = j_lo + 1 do i=G%isc, G%iec if (associated(mask)) then if (mask(i,j,1) == 0.) cycle endif - h_src(:) = 0.5 * (h(i,j,:) + h(i,j+1,:)) - h_dest(:) = 0.5 * (remap_cs%h(i,j,:) + remap_cs%h(i,j+1,:) ) - call remapping_core_h(remap_cs%remap_cs, nz_src, h_src(:), field(i,J,:), & - nz_dest, h_dest(:), remapped_field(i,J,:), & + h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) + h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) + call remapping_core_h(remap_cs%remap_cs, & + nz_src, h_src(:), field(i,J1,:), & + nz_dest, h_dest(:), remapped_field(i,J1,:), & h_neglect, h_neglect_edge) enddo enddo @@ -363,11 +414,12 @@ subroutine diag_remap_do_remap(remap_cs, G, GV, h, staggered_in_x, staggered_in_ do j=G%jsc, G%jec do i=G%isc, G%iec if (associated(mask)) then - if (mask(i,j, 1) == 0.) cycle + if (mask(i,j,1) == 0.) cycle endif h_src(:) = h(i,j,:) h_dest(:) = remap_cs%h(i,j,:) - call remapping_core_h(remap_cs%remap_cs, nz_src, h_src(:), field(i,j,:), & + call remapping_core_h(remap_cs%remap_cs, & + nz_src, h_src(:), field(i,j,:), & nz_dest, h_dest(:), remapped_field(i,j,:), & h_neglect, h_neglect_edge) enddo @@ -437,7 +489,10 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, staggered_in_x, sta real, dimension(remap_cs%nz) :: h_dest real, dimension(size(h,3)) :: h_src integer :: nz_src, nz_dest - integer :: i, j, k + integer :: i, j, k !< Grid index + integer :: i1, j1 !< 1-based index + integer :: i_lo, i_hi, j_lo, j_hi !< (uv->h) interpolation indices + integer :: shift !< Symmetric offset for 1-based indexing call assert(remap_cs%initialized, 'vertically_reintegrate_diag_field: remap_cs not initialized.') call assert(size(field, 3) == size(h, 3), & @@ -447,30 +502,37 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, staggered_in_x, sta nz_dest = remap_cs%nz reintegrated_field(:,:,:) = 0. + ! Symmetric grid offset under 1-based indexing; see header for details. + shift = 0; if (G%symmetric) shift = 1 + if (staggered_in_x .and. .not. staggered_in_y) then ! U-points do j=G%jsc, G%jec do I=G%iscB, G%iecB + i1 = i - G%isdB + 1 + i_lo = i1 - shift; i_hi = i_lo + 1 if (associated(mask)) then if (mask(i,j,1) == 0.) cycle endif - h_src(:) = 0.5 * (h(i,j,:) + h(i+1,j,:)) - h_dest(:) = 0.5 * ( remap_cs%h(i,j,:) + remap_cs%h(i+1,j,:) ) - call reintegrate_column(nz_src, h_src, field(I,j,:), & - nz_dest, h_dest, 0., reintegrated_field(I,j,:)) + h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) + h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) + call reintegrate_column(nz_src, h_src, field(I1,j,:), & + nz_dest, h_dest, 0., reintegrated_field(I1,j,:)) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then ! V-points do J=G%jscB, G%jecB + j1 = j - G%jsdB + 1 + j_lo = j1 - shift; j_hi = j_lo + 1 do i=G%isc, G%iec if (associated(mask)) then if (mask(i,j,1) == 0.) cycle endif - h_src(:) = 0.5 * (h(i,j,:) + h(i,j+1,:)) - h_dest(:) = 0.5 * ( remap_cs%h(i,j,:) + remap_cs%h(i,j+1,:) ) - call reintegrate_column(nz_src, h_src, field(i,J,:), & - nz_dest, h_dest, 0., reintegrated_field(i,J,:)) + h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) + h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) + call reintegrate_column(nz_src, h_src, field(i,J1,:), & + nz_dest, h_dest, 0., reintegrated_field(i,J1,:)) enddo enddo elseif ((.not. staggered_in_x) .and. (.not. staggered_in_y)) then @@ -478,7 +540,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, staggered_in_x, sta do j=G%jsc, G%jec do i=G%isc, G%iec if (associated(mask)) then - if (mask(i,j, 1) == 0.) cycle + if (mask(i,j,1) == 0.) cycle endif h_src(:) = h(i,j,:) h_dest(:) = remap_cs%h(i,j,:) @@ -508,7 +570,10 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta real, dimension(remap_cs%nz) :: h_dest real, dimension(size(h,3)) :: h_src integer :: nz_src, nz_dest - integer :: i, j, k + integer :: i, j, k !< Grid index + integer :: i1, j1 !< 1-based index + integer :: i_lo, i_hi, j_lo, j_hi !< (uv->h) interpolation indices + integer :: shift !< Symmetric offset for 1-based indexing call assert(remap_cs%initialized, 'vertically_interpolate_diag_field: remap_cs not initialized.') call assert(size(field, 3) == size(h, 3)+1, & @@ -519,30 +584,37 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta nz_src = size(h,3) nz_dest = remap_cs%nz + ! Symmetric grid offset under 1-based indexing; see header for details. + shift = 0; if (G%symmetric) shift = 1 + if (staggered_in_x .and. .not. staggered_in_y) then ! U-points do j=G%jsc, G%jec do I=G%iscB, G%iecB + i1 = i - G%isdB + 1 + i_lo = i1 - shift; i_hi = i_lo + 1 if (associated(mask)) then if (mask(i,j,1) == 0.) cycle endif - h_src(:) = 0.5 * (h(i,j,:) + h(i+1,j,:)) - h_dest(:) = 0.5 * ( remap_cs%h(i,j,:) + remap_cs%h(i+1,j,:) ) - call interpolate_column(nz_src, h_src, field(I,j,:), & - nz_dest, h_dest, 0., interpolated_field(I,j,:)) + h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) + h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) + call interpolate_column(nz_src, h_src, field(I1,j,:), & + nz_dest, h_dest, 0., interpolated_field(I1,j,:)) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then ! V-points do J=G%jscB, G%jecB + j1 = j - G%jsdB + 1 + j_lo = j1 - shift; j_hi = j_lo + 1 do i=G%isc, G%iec if (associated(mask)) then if (mask(i,j,1) == 0.) cycle endif - h_src(:) = 0.5 * (h(i,j,:) + h(i,j+1,:)) - h_dest(:) = 0.5 * ( remap_cs%h(i,j,:) + remap_cs%h(i,j+1,:) ) - call interpolate_column(nz_src, h_src, field(i,J,:), & - nz_dest, h_dest, 0., interpolated_field(i,J,:)) + h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) + h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) + call interpolate_column(nz_src, h_src, field(i,J1,:), & + nz_dest, h_dest, 0., interpolated_field(i,J1,:)) enddo enddo elseif ((.not. staggered_in_x) .and. (.not. staggered_in_y)) then @@ -550,7 +622,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta do j=G%jsc, G%jec do i=G%isc, G%iec if (associated(mask)) then - if (mask(i,j, 1) == 0.) cycle + if (mask(i,j,1) == 0.) cycle endif h_src(:) = h(i,j,:) h_dest(:) = remap_cs%h(i,j,:) From edb2b32f59740effc997a1c4b9d83791abed6350 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 10 Jun 2019 09:41:10 -0400 Subject: [PATCH 083/106] Vertical remap index syntax adjustment Indices on u and v points were capitalised, as is convention. --- src/framework/MOM_diag_remap.F90 | 36 ++++++++++++++++---------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index d62c0fe324..0bc9f21602 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -379,10 +379,10 @@ subroutine diag_remap_do_remap(remap_cs, G, GV, h, staggered_in_x, staggered_in_ ! U-points do j=G%jsc, G%jec do I=G%iscB, G%iecB - i1 = i - G%isdB + 1 - i_lo = i1 - shift; i_hi = i_lo + 1 + I1 = I - G%isdB + 1 + i_lo = I1 - shift; i_hi = i_lo + 1 if (associated(mask)) then - if (mask(i,j,1) == 0.) cycle + if (mask(I,j,1) == 0.) cycle endif h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) @@ -395,11 +395,11 @@ subroutine diag_remap_do_remap(remap_cs, G, GV, h, staggered_in_x, staggered_in_ elseif (staggered_in_y .and. .not. staggered_in_x) then ! V-points do J=G%jscB, G%jecB - j1 = j - G%jsdB + 1 - j_lo = j1 - shift; j_hi = j_lo + 1 + J1 = J - G%jsdB + 1 + j_lo = J1 - shift; j_hi = j_lo + 1 do i=G%isc, G%iec if (associated(mask)) then - if (mask(i,j,1) == 0.) cycle + if (mask(i,J,1) == 0.) cycle endif h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) @@ -509,10 +509,10 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, staggered_in_x, sta ! U-points do j=G%jsc, G%jec do I=G%iscB, G%iecB - i1 = i - G%isdB + 1 - i_lo = i1 - shift; i_hi = i_lo + 1 + I1 = I - G%isdB + 1 + i_lo = I1 - shift; i_hi = i_lo + 1 if (associated(mask)) then - if (mask(i,j,1) == 0.) cycle + if (mask(I,j,1) == 0.) cycle endif h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) @@ -523,11 +523,11 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, staggered_in_x, sta elseif (staggered_in_y .and. .not. staggered_in_x) then ! V-points do J=G%jscB, G%jecB - j1 = j - G%jsdB + 1 - j_lo = j1 - shift; j_hi = j_lo + 1 + J1 = J - G%jsdB + 1 + j_lo = J1 - shift; j_hi = j_lo + 1 do i=G%isc, G%iec if (associated(mask)) then - if (mask(i,j,1) == 0.) cycle + if (mask(i,J,1) == 0.) cycle endif h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) @@ -591,10 +591,10 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta ! U-points do j=G%jsc, G%jec do I=G%iscB, G%iecB - i1 = i - G%isdB + 1 - i_lo = i1 - shift; i_hi = i_lo + 1 + I1 = I - G%isdB + 1 + i_lo = I1 - shift; i_hi = i_lo + 1 if (associated(mask)) then - if (mask(i,j,1) == 0.) cycle + if (mask(I,j,1) == 0.) cycle endif h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) @@ -605,11 +605,11 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta elseif (staggered_in_y .and. .not. staggered_in_x) then ! V-points do J=G%jscB, G%jecB - j1 = j - G%jsdB + 1 - j_lo = j1 - shift; j_hi = j_lo + 1 + J1 = J - G%jsdB + 1 + j_lo = J1 - shift; j_hi = j_lo + 1 do i=G%isc, G%iec if (associated(mask)) then - if (mask(i,j,1) == 0.) cycle + if (mask(i,J,1) == 0.) cycle endif h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) From 418bece693de7cc18bcb738f7539b9a5de5d39cc Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Wed, 12 Jun 2019 13:12:58 -0400 Subject: [PATCH 084/106] Updating sponge and tracer --- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/RGC_tracer.F90 | 150 ++++++++----------------- src/user/RGC_initialization.F90 | 34 ++---- 3 files changed, 53 insertions(+), 133 deletions(-) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index ff87df5af4..d937f27d92 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -90,7 +90,7 @@ module MOM_tracer_flow_control type(USER_tracer_example_CS), pointer :: USER_tracer_example_CSp => NULL() type(DOME_tracer_CS), pointer :: DOME_tracer_CSp => NULL() type(ISOMIP_tracer_CS), pointer :: ISOMIP_tracer_CSp => NULL() - type(RGC_tracer_CS), pointer :: RGC_tracer_CSp => NULL() + type(RGC_tracer_CS), pointer :: RGC_tracer_CSp => NULL() type(ideal_age_tracer_CS), pointer :: ideal_age_tracer_CSp => NULL() type(dye_tracer_CS), pointer :: dye_tracer_CSp => NULL() type(oil_tracer_CS), pointer :: oil_tracer_CSp => NULL() diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index d75a12413f..697638457b 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -1,37 +1,34 @@ -!> This module contains the routines used to set up and use a set of (one for now) -!! dynamically passive tracers. For now, three passive tracers can be injected in -!! the domain +!> This module contains the routines used to set up a +!! dynamically passive tracer. !! Set up and use passive tracers requires the following: !! (1) register_RGC_tracer !! (2) apply diffusion, physics/chemistry and advect the tracer !********+*********+*********+*********+*********+*********+*********+** !* * -!* By Elizabeth Yankovsky, May 2018 * +!* By Elizabeth Yankovsky, June 2019 * !*********+*********+*********+*********+*********+*********+*********** module RGC_tracer ! This file is part of MOM6. See LICENSE.md for the license. -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, is_root_pe +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_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : MOM_restart_CS use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS, get_ALE_sponge_nz_data use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time -use MOM_tracer_registry, only : register_tracer, tracer_registry_type +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_variables, only : surface use MOM_open_boundary, only : ocean_OBC_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_coms, only : max_across_PEs, min_across_PEs implicit none ; private @@ -41,44 +38,25 @@ module RGC_tracer public register_RGC_tracer, initialize_RGC_tracer public RGC_tracer_column_physics, RGC_tracer_end -!< ntr is the number of tracers in this module. -integer, parameter :: NTR = 1 - -type p3d - real, dimension(:,:,:), pointer :: p => NULL() -end type p3d +integer, parameter :: NTR = 1 !< The number of tracers in this module. !> tracer control structure type, public :: RGC_tracer_CS ; private - logical :: coupled_tracers = .false. !< These tracers are not offered to the - !< coupler. - character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " " - !< to initialize internally. + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this - !< subroutine - real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration - !< for output - type(p3d), dimension(NTR) :: & - tr_adx, &!< Tracer zonal advective fluxes in g m-3 m3 s-1. - tr_ady, &!< Tracer meridional advective fluxes in g m-3 m3 s-1. - tr_dfx, &!< Tracer zonal diffusive fluxes in g m-3 m3 s-1. - tr_dfy !< Tracer meridional diffusive fluxes in g m-3 m3 s-1. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package. + real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration. real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. real :: lenlat ! the latitudinal or y-direction length of the domain. real :: lenlon ! the longitudinal or x-direction length of the domain. real :: CSL ! The length of the continental shelf (x dir, km) real :: lensponge ! the length of the sponge layer. logical :: mask_tracers !< If true, tracers are masked out in massless layers. - logical :: use_sponge - - type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the - !< timing of diagnostic output. - integer, dimension(NTR) :: id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1 - integer, dimension(NTR) :: id_tr_dfx = -1, id_tr_dfy = -1 - - type(vardesc) :: tr_desc(NTR) + logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. + type(vardesc) :: tr_desc(NTR) !< Descriptions and metadata for the tracers. end type RGC_tracer_CS contains @@ -89,7 +67,7 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI ! CS%tr(:,:,:,m) ! Register the tracer for horizontal advection & diffusion. call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & @@ -179,9 +156,9 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & logical, intent(in) :: restart !< .true. if the fields have already been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(diag_ctrl), target, intent(in) :: diag + type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. - type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call to RGC_register_tracer. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call to RGC_register_tracer. type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. @@ -202,7 +179,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. - real :: e(SZK_(G)+1), e_top, e_bot, d_tr + real :: e(SZK_(G)+1), e_top, e_bot, d_tr ! Heights [Z ~> m]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB integer :: nzdata @@ -245,7 +222,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & endif ! restart if ( CS%use_sponge ) then -! If sponges are used, this damps values to zero in the offshore boundary. +! If sponges are used, this damps values to zero in the offshore boundary. ! For any tracers that are not damped in the sponge, the call ! to set_up_sponge_field can simply be omitted. if (associated(sponge_CSp)) then !ALE mode @@ -258,14 +235,12 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & endif enddo ; enddo; enddo do m=1,1 - ! This is needed to force the compiler not to do a copy in the sponge - ! calls. Curses on the designers and implementers of Fortran90. + ! This is needed to force the compiler not to do a copy in the sponge calls. tr_ptr => CS%tr(:,:,:,m) call set_up_ALE_sponge_field(temp, G, tr_ptr, sponge_CSp) enddo deallocate(temp) endif -! endif !ALE mode elseif (associated(layer_CSp)) then !layer mode if (nz>0) then @@ -281,7 +256,6 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & enddo deallocate(temp) endif -! endif !Layer mode else call MOM_error(FATAL, "RGC_initialize_tracer: "// & "The pointer to sponge_CSp must be associated if SPONGE is defined.") @@ -294,16 +268,26 @@ end subroutine initialize_RGC_tracer ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & - aggregate_FW_forcing, evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G - type(verticalGrid_type), intent(in) :: GV - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt - type(RGC_tracer_CS), pointer :: CS - logical, optional,intent(in) :: aggregate_FW_forcing - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + evap_CFL_limit, minimum_forcing_depth) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + 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 any possible forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call [s]. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. + real, optional,intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be fluxed out of the top layer in a timestep [nondim]. + real, optional,intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes can be applied [m]. ! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. ! (in) h_new - Layer thickness after entrainment, in m or kg m-2. @@ -313,24 +297,12 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, ! (in) eb - an array to which the amount of fluid entrained ! from the layer below during this call will be ! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! RGC_register_tracer. -! ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] real :: b1(SZI_(G)) ! b1 and c1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified - real :: melt(SZI_(G),SZJ_(G)) ! melt water (positive for melting - ! negative for freezing) - real :: salt_flux(SZI_(G),SZJ_(G)) ! salt flux, positive into ocean - real :: mass(SZI_(G),SZJ_(G)) ! mass of water in the mixed layer (approximate) real :: in_flux(SZI_(G),SZJ_(G),2) ! total amount of tracer to be injected integer :: i, j, k, is, ie, js, je, nz, m @@ -363,48 +335,14 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, enddo endif - if (CS%mask_tracers) then - do m = 1,NTR ; if (CS%id_tracer(m) > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - CS%tr_aux(i,j,k,m) = CS%tr(i,j,k,m) - enddo ; enddo ; enddo - endif ; enddo - endif - - do m=1,NTR - if (CS%mask_tracers) then - if (CS%id_tracer(m)>0) & - call post_data(CS%id_tracer(m),CS%tr_aux(:,:,:,m),CS%diag) - else - if (CS%id_tracer(m)>0) & - call post_data(CS%id_tracer(m),CS%tr(:,:,:,m),CS%diag) - endif - if (CS%id_tr_adx(m)>0) & - call post_data(CS%id_tr_adx(m),CS%tr_adx(m)%p(:,:,:),CS%diag) - if (CS%id_tr_ady(m)>0) & - call post_data(CS%id_tr_ady(m),CS%tr_ady(m)%p(:,:,:),CS%diag) - if (CS%id_tr_dfx(m)>0) & - call post_data(CS%id_tr_dfx(m),CS%tr_dfx(m)%p(:,:,:),CS%diag) - if (CS%id_tr_dfy(m)>0) & - call post_data(CS%id_tr_dfy(m),CS%tr_dfy(m)%p(:,:,:),CS%diag) - enddo - end subroutine RGC_tracer_column_physics subroutine RGC_tracer_end(CS) - type(RGC_tracer_CS), pointer :: CS + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call to RGC_register_tracer. integer :: m if (associated(CS)) then if (associated(CS%tr)) deallocate(CS%tr) - if (associated(CS%tr_aux)) deallocate(CS%tr_aux) - do m=1,NTR - if (associated(CS%tr_adx(m)%p)) deallocate(CS%tr_adx(m)%p) - if (associated(CS%tr_ady(m)%p)) deallocate(CS%tr_ady(m)%p) - if (associated(CS%tr_dfx(m)%p)) deallocate(CS%tr_dfx(m)%p) - if (associated(CS%tr_dfy(m)%p)) deallocate(CS%tr_dfy(m)%p) - enddo - deallocate(CS) endif end subroutine RGC_tracer_end diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 11b61f8d69..69e7da027d 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -29,34 +29,19 @@ module RGC_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_io, only : close_file, fieldtype, file_exists -use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE -use MOM_io, only : write_field, slasher, vardesc +use MOM_io, only : file_exists, read_data +use MOM_io, only : slasher use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type -use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE -use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR -use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA use MOM_domains, only: pass_var implicit none ; private #include -! ----------------------------------------------------------------------------- -! Private (module-wise) parameters -! ----------------------------------------------------------------------------- - character(len=40) :: mod = "RGC_initialization" ! This module's name. - -! ----------------------------------------------------------------------------- -! The following routines are visible to the outside world -! ----------------------------------------------------------------------------- public RGC_initialize_sponges -! ----------------------------------------------------------------------------- -! This module contains the following routines -! ----------------------------------------------------------------------------- contains !> Sets up the the inverse restoration time (Idamp), and @@ -70,8 +55,8 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< u velocity. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< v velocity. type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model !! parameter values. @@ -90,12 +75,9 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points, in s-1. real :: TNUDG ! Nudging time scale, days real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. - ! positive upward, in m. logical :: sponge_uv ! Nudge velocities (u and v) towards zero real :: min_depth, dummy1, z, delta_h @@ -113,12 +95,12 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) call get_param(PF,mod,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) - call get_param(PF, mod, "IDEAL_IS_TNUDG", TNUDG, 'Nudging time scale for sponge layers (days)', default=0.0) + call get_param(PF, mod, "RGC_TNUDG", TNUDG, 'Nudging time scale for sponge layers (days)', default=0.0) call get_param(PF, mod, "LENLAT", lenlat, & "The latitudinal or y-direction length of the domain", & fail_if_missing=.true., do_not_log=.true.) - + call get_param(PF, mod, "LENLON", lenlon, & "The longitudinal or x-direction length of the domain", & fail_if_missing=.true., do_not_log=.true.) @@ -177,7 +159,7 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! because of the FIT_SALINITY option. To get salt values right in the ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mod, "IDEAL_IS_SPONGE_FILE", state_file, & + call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & "The name of the file with temps., salts. and interfaces to \n"// & " damp toward.", fail_if_missing=.true.) call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & @@ -220,7 +202,7 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) endif - + else ! layer mode From 1864ae7f3b41949298cc6e98b81192cbcbf31b6a Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Wed, 12 Jun 2019 13:24:16 -0400 Subject: [PATCH 085/106] Correcting code comments --- src/tracer/RGC_tracer.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 697638457b..31670ff47d 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -49,10 +49,10 @@ module RGC_tracer real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package. real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration. real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. - real :: lenlat ! the latitudinal or y-direction length of the domain. - real :: lenlon ! the longitudinal or x-direction length of the domain. - real :: CSL ! The length of the continental shelf (x dir, km) - real :: lensponge ! the length of the sponge layer. + real :: lenlat !< the latitudinal or y-direction length of the domain. + real :: lenlon !< the longitudinal or x-direction length of the domain. + real :: CSL !< The length of the continental shelf (x dir, km) + real :: lensponge !< the length of the sponge layer. logical :: mask_tracers !< If true, tracers are masked out in massless layers. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. From 65b94012265539aab25d97cce5732ea7fa018166 Mon Sep 17 00:00:00 2001 From: Elizabeth Yankovsky Date: Wed, 12 Jun 2019 13:37:44 -0400 Subject: [PATCH 086/106] Fixing formatting --- src/tracer/RGC_tracer.F90 | 4 ++-- src/user/RGC_initialization.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 31670ff47d..b056ae3a76 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -1,4 +1,4 @@ -!> This module contains the routines used to set up a +!> This module contains the routines used to set up a !! dynamically passive tracer. !! Set up and use passive tracers requires the following: !! (1) register_RGC_tracer @@ -6,7 +6,7 @@ !********+*********+*********+*********+*********+*********+*********+** !* * -!* By Elizabeth Yankovsky, June 2019 * +!* By Elizabeth Yankovsky, June 2019 * !*********+*********+*********+*********+*********+*********+*********** module RGC_tracer diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 69e7da027d..f0000dc03d 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -17,7 +17,7 @@ module RGC_initialization !* write to: Free Software Foundation, Inc., * !* 675 Mass Ave, Cambridge, MA 02139, USA. * !* or see: http://www.gnu.org/licenses/gpl.html * -!* By Elizabeth Yankovsky, May 2018 * +!* By Elizabeth Yankovsky, May 2018 * !*********************************************************************** use MOM_ALE_sponge, only : ALE_sponge_CS, set_up_ALE_sponge_field, initialize_ALE_sponge From e6033c09aff2b02807e791d575d39860d63bc275 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 15 Jun 2019 10:55:24 -0400 Subject: [PATCH 087/106] (*) Bugfix: reproducing_sum, bin equals prec In reproducing_sum, if a bin inside int_sum is exactly equal to prec (currently 2**46 to some integer power) then this value will not be transferred up to the next bin, due to the > check rather than a >= check. See code block below: 562 do i=ni,2,-1 ; if (abs(int_sum(i)) > prec) then 563 num_carry = int(int_sum(i) * I_prec) 564 int_sum(i) = int_sum(i) - num_carry*prec 565 int_sum(i-1) = int_sum(i-1) + num_carry 566 endif ; enddo This can cause inconsistency in reproducibility across CPUs, particularly on 1 rank, since the construction of int_sum will not produce filled bins of size prec. We fix this by replacing the > check with a >=, so that both overfilled and exactly full values in a bin are also transferred up to the next bin. We specifically fix this in regularize_ints, but also in carry_overflow for the sake of consistency. This was observed in the mean calculations of a few sparse diagnostics at isolated timesteps for certain CPU layouts, and caused variation in the least significant bit (LSB). When the patch was applied, results were consistent with the 1-rank result. It seems like a phenomenal coincidence that a bin value managed to exactly equal prec, which may indicate a further systematic error somewhere, but that can be treated as a separate issue. While this change has the potential to modify answers, since we are modifying the results of `reproducing_sum`, no changes were observed in the regression tests. --- src/framework/MOM_coms.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 47601db679..136455dfe6 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -535,7 +535,7 @@ subroutine carry_overflow(int_sum, prec_error) ! This subroutine handles carrying of the overflow. integer :: i, num_carry - do i=ni,2,-1 ; if (abs(int_sum(i)) > prec) then + do i=ni,2,-1 ; if (abs(int_sum(i)) >= prec) then num_carry = int(int_sum(i) * I_prec) int_sum(i) = int_sum(i) - num_carry*prec int_sum(i-1) = int_sum(i-1) + num_carry @@ -559,7 +559,7 @@ subroutine regularize_ints(int_sum) logical :: positive integer :: i, num_carry - do i=ni,2,-1 ; if (abs(int_sum(i)) > prec) then + do i=ni,2,-1 ; if (abs(int_sum(i)) >= prec) then num_carry = int(int_sum(i) * I_prec) int_sum(i) = int_sum(i) - num_carry*prec int_sum(i-1) = int_sum(i-1) + num_carry From f19a173423d97561a29b951410c8691232eaeabb Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 17 Jun 2019 10:26:51 -0400 Subject: [PATCH 088/106] (*) Z-remap interface mask{Cu,Cv,B}i bugfix Z-interpolated diagnostics on interfaces were failing to produce consistent answers when CPU layout was changed. This was tracked down to an error in the eastern boundaries of their mask fields. These mask fields are constructed from the T-point mask, maskTi, whose halo values were not being constructed. By extending the loops from [ij]sc..[ij]ec to [ij]sc-1 .. [ij]ec+1, we restored the masks and could reproduce the values. This will affect the following diagnostics when z-remapped: * neutral_slope_[xy] * KHTH_[uv] and potentially any other diagnostics on the `axesCui` axis. --- src/framework/MOM_diag_mediator.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 4c91518e51..d17bc5707b 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -750,7 +750,7 @@ subroutine set_masks_for_axes(G, diag_cs) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at h-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk+1) ) ; axes%mask3d(:,:,:) = 0. - do J=G%jsc-1,G%jec ; do i=G%isc,G%iec + do J=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 if (h_axes%mask3d(i,j,1) > 0.) axes%mask3d(i,J,1) = 1. do K = 2, nk if (h_axes%mask3d(i,j,k-1) + h_axes%mask3d(i,j,k) > 0.) axes%mask3d(i,J,k) = 1. From 1e30eb37b05415254a584a003c4b80616742728b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 14 Jun 2019 11:38:01 -0400 Subject: [PATCH 089/106] (*) Remapped d[uv]dt_dia, [uv]hml diagnostic fixes The remapped diagnostics d[uv]dt_dia, and uhml were reporting different results for different CPU layouts. This was due to a dependence on the east and north halo values of the h and remap_cs%h thicknesses, which were not being updated for these variables. The remap_cs%h thickness directly depends on h, and will properly fill in its halo values, but is only updated when a `diag_update_remap_grids` function is called. If h has missing halo values prior to this call, then remap_cs%h will also be missing. In most of the code, h has been properly updated, and remap_cs%h only needs an update when h changes, which is restricted to a few functions. This appears to not be an issue for most diagnostics, with the ones above being an exception. We resolve this by applying a halo update to h prior to any `diag_update_remap_grids` calls which are needed before the diagnostic `post_data` call. We only apply this halo update if the diagnostic has been registered. Ideally we would only apply the halo update when the remapped halo has been registered, but it is currently not possible to query this information, and ought to be done in a future release. It is likely that there are more diagnostics with this issue, so consider this a first step. --- src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 | 5 ++++- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 6 ++++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 5507ebea16..f9db6eba2b 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -7,7 +7,7 @@ module MOM_mixed_layer_restrat use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_diag_mediator, only : diag_update_remap_grids -use MOM_domains, only : pass_var +use MOM_domains, only : pass_var, To_West, To_South, Omit_Corners use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : mech_forcing @@ -750,6 +750,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. + if (CS%id_uhml > 0 .or. CS%id_vhml > 0) & + ! Remapped uhml and vhml require east/north halo updates of h + call pass_var(h, G%domain, To_West+To_South+Omit_Corners, halo=1) call diag_update_remap_grids(CS%diag) ! Offer diagnostic fields for averaging. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f42a0dd28d..e21192bfae 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1645,7 +1645,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en 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 - ! XXX: Need to remove those US%s_to_T array multiply ops call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) @@ -2016,6 +2015,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. + if (CS%id_dudt_dia > 0 .or. CS%id_dvdt_dia > 0) & + ! Remapped d[uv]dt_dia require east/north halo updates of h + call pass_var(h, G%domain, To_West+To_South+Omit_Corners, halo=1) call diag_update_remap_grids(CS%diag) ! diagnostics @@ -2413,7 +2415,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth -end subroutine +end subroutine extract_diabatic_member !> Routine called for adiabatic physics subroutine adiabatic(h, tv, fluxes, dt, G, GV, CS) From 4a2c2121a55310b93cb0d5cb3544b60fbe739f0a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 17 Jun 2019 14:44:58 -0400 Subject: [PATCH 090/106] (*) Horizontal remapping re-enabled, bugfixes This patch re-enabled the `post_xy_average` calls in `post_data_3d_low`, which are used to generate and write the horizontally averaged diagnostics. We have also fixed a number of issues in the existing methods, and we have changed how masked values are handled. The first major change is that average of a field is now computed on the native grid points, rather than interpolation onto h-points. This is due to a dependence on halo values of `h` which would be potentially undefined in symmetric grids. In most cases the calculation will be mathematically equivalent, although there will be bitwise differences. Non-periodic boundaries may also yield different edge values which will modify the average. The second major change is the introduction of a reproducible sum for the calculation of the total volume and field at each vertical level, which will introduce bitwise changes but is now reproducible across layouts. The final change is the removal of explicit `missing_value` checks, which have been replaced with a new column mask. Masked values are now explicitly set to zero. This simplifies the calculation of any averages or checksums, and is also consistent with the overall removal of explicit missing_value usage in MOM. These changes have removed depenendies on unassigned values in symmetric grids, and produce results which are now reproducible across layouts and for symmetric and nonsymmetric grids. Diagnostic values are expected to change, but the model state should be bitwise reproducible. --- src/framework/MOM_diag_mediator.F90 | 15 +++- src/framework/MOM_diag_remap.F90 | 117 +++++++++++++--------------- 2 files changed, 66 insertions(+), 66 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index d17bc5707b..5acc240445 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -787,7 +787,6 @@ subroutine set_masks_for_axes(G, diag_cs) if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. enddo ; enddo ; enddo - endif enddo @@ -1706,6 +1705,11 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) endif endif endif + + if (diag%fms_xyave_diag_id>0) then + call post_xy_average(diag_cs, diag, locfield) + endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.) .and. dl<2) & deallocate( locfield ) @@ -1718,6 +1722,7 @@ subroutine post_xy_average(diag_cs, diag, field) type(diag_ctrl), intent(in) :: diag_cs !< Diagnostics mediator control structure ! Local variable real, dimension(size(field,3)) :: averaged_field + logical, dimension(size(field,3)) :: averaged_mask logical :: staggered_in_x, staggered_in_y, used integer :: nz, remap_nz, coord @@ -1732,7 +1737,8 @@ subroutine post_xy_average(diag_cs, diag, field) call horizontally_average_diag_field(diag_cs%G, diag_cs%h, & staggered_in_x, staggered_in_y, & diag%axes%is_layer, diag%v_extensive, & - diag_cs%missing_value, field, averaged_field) + diag_cs%missing_value, field, & + averaged_field, averaged_mask) else nz = size(field, 3) coord = diag%axes%vertical_coordinate_number @@ -1749,11 +1755,12 @@ subroutine post_xy_average(diag_cs, diag, field) call horizontally_average_diag_field(diag_cs%G, diag_cs%diag_remap_cs(coord)%h, & staggered_in_x, staggered_in_y, & diag%axes%is_layer, diag%v_extensive, & - diag_cs%missing_value, field, averaged_field) + diag_cs%missing_value, field, & + averaged_field, averaged_mask) endif used = send_data(diag%fms_xyave_diag_id, averaged_field, diag_cs%time_end, & - weight=diag_cs%time_int) + weight=diag_cs%time_int, mask=averaged_mask) end subroutine post_xy_average !> This subroutine enables the accumulation of time averages over the specified time interval. diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 0bc9f21602..6640a4b15a 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -57,7 +57,7 @@ module MOM_diag_remap ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coms, only : sum_across_PEs +use MOM_coms, only : reproducing_sum use MOM_error_handler, only : MOM_error, FATAL, assert, WARNING use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_file_parser, only : get_param, log_param, param_file_type @@ -639,7 +639,8 @@ end subroutine vertically_interpolate_diag_field !> Horizontally average field subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, & is_layer, is_extensive, & - missing_value, field, averaged_field) + missing_value, field, averaged_field, & + averaged_mask) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure real, dimension(:,:,:), intent(in) :: h !< The current thicknesses logical, intent(in) :: staggered_in_x !< True if the x-axis location is at u or q points @@ -649,13 +650,20 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, real, intent(in) :: missing_value !< A missing_value to assign land/vanished points real, dimension(:,:,:), intent(in) :: field !< The diagnostic field to be remapped real, dimension(:), intent(inout) :: averaged_field !< Field argument horizontally averaged + logical, dimension(:), intent(inout) :: averaged_mask !< Mask for horizontally averaged field + ! Local variables + real, dimension(G%isc:G%iec, G%jsc:G%jec, size(field,3)) :: volume, stuff real, dimension(size(field, 3)) :: vol_sum, stuff_sum ! nz+1 is needed for interface averages - real :: v1, v2, total_volume, total_stuff, val + real :: height integer :: i, j, k, nz + integer :: i1, j1 !< 1-based index nz = size(field, 3) + ! TODO: These averages could potentially be modified to use the function in + ! the MOM_spatial_means module. + if (staggered_in_x .and. .not. staggered_in_y) then if (is_layer) then ! U-points @@ -663,30 +671,26 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, vol_sum(k) = 0. stuff_sum(k) = 0. if (is_extensive) then - do j=G%jsc, G%jec ; do i=G%isc, G%iec - v1 = G%areaCu(I,j) - v2 = G%areaCu(I-1,j) - vol_sum(k) = vol_sum(k) + 0.5 * ( v1 + v2 ) * G%mask2dT(i,j) - stuff_sum(k) = stuff_sum(k) + 0.5 * ( v1 * field(I,j,k) + v2 * field(I-1,j,k) ) * G%mask2dT(i,j) + do j=G%jsc, G%jec ; do I=G%isc, G%iec + I1 = I - G%isdB + 1 + volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo else ! Intensive - do j=G%jsc, G%jec ; do i=G%isc, G%iec - v1 = G%areaCu(I,j) * 0.5 * ( h(i,j,k) + h(i+1,j,k) ) - v2 = G%areaCu(I-1,j) * 0.5 * ( h(i,j,k) + h(i-1,j,k) ) - vol_sum(k) = vol_sum(k) + 0.5 * ( v1 + v2 ) * G%mask2dT(i,j) - stuff_sum(k) = stuff_sum(k) + 0.5 * ( v1 * field(I,j,k) + v2 * field(I-1,j,k) ) * G%mask2dT(i,j) + do j=G%jsc, G%jec ; do I=G%isc, G%iec + I1 = i - G%isdB + 1 + height = 0.5 * (h(i,j,k) + h(i+1,j,k)) + volume(I,j,k) = G%areaCu(I,j) * height * G%mask2dCu(I,j) + stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo endif enddo else ! Interface do k=1,nz - vol_sum(k) = 0. - stuff_sum(k) = 0. - do j=G%jsc, G%jec ; do i=G%isc, G%iec - v1 = G%areaCu(I,j) - v2 = G%areaCu(I-1,j) - vol_sum(k) = vol_sum(k) + 0.5 * ( v1 + v2 ) * G%mask2dT(i,j) - stuff_sum(k) = stuff_sum(k) + 0.5 * ( v1 * field(I,j,k) + v2 * field(I-1,j,k) ) * G%mask2dT(i,j) + do j=G%jsc, G%jec ; do I=G%isc, G%iec + I1 = I - G%isdB + 1 + volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo enddo endif @@ -694,33 +698,27 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_layer) then ! V-points do k=1,nz - vol_sum(k) = 0. - stuff_sum(k) = 0. if (is_extensive) then - do j=G%jsc, G%jec ; do i=G%isc, G%iec - v1 = G%areaCv(i,J) - v2 = G%areaCv(i,J-1) - vol_sum(k) = vol_sum(k) + 0.5 * ( v1 + v2 ) * G%mask2dT(i,j) - stuff_sum(k) = stuff_sum(k) + 0.5 * ( v1 * field(i,J,k) + v2 * field(i,J-1,k) ) * G%mask2dT(i,j) + do J=G%jsc, G%jec ; do i=G%isc, G%iec + J1 = J - G%jsdB + 1 + volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo else ! Intensive - do j=G%jsc, G%jec ; do i=G%isc, G%iec - v1 = G%areaCv(i,J) * 0.5 * ( h(i,j,k) + h(i,j+1,k) ) - v2 = G%areaCv(i,J-1) * 0.5 * ( h(i,j,k) + h(i,j-1,k) ) - vol_sum(k) = vol_sum(k) + 0.5 * ( v1 + v2 ) * G%mask2dT(i,j) - stuff_sum(k) = stuff_sum(k) + 0.5 * ( v1 * field(i,J,k) + v2 * field(i,J-1,k) ) * G%mask2dT(i,j) + do J=G%jsc, G%jec ; do i=G%isc, G%iec + J1 = J - G%jsdB + 1 + height = 0.5 * (h(i,j,k) + h(i,j+1,k)) + volume(i,J,k) = G%areaCv(i,J) * height * G%mask2dCv(i,J) + stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo endif enddo else ! Interface do k=1,nz - vol_sum(k) = 0. - stuff_sum(k) = 0. - do j=G%jsc, G%jec ; do i=G%isc, G%iec - v1 = G%areaCv(i,J) - v2 = G%areaCv(i,J-1) - vol_sum(k) = vol_sum(k) + 0.5 * ( v1 + v2 ) * G%mask2dT(i,j) - stuff_sum(k) = stuff_sum(k) + 0.5 * ( v1 * field(i,J,k) + v2 * field(i,J-1,k) ) * G%mask2dT(i,j) + do J=G%jsc, G%jec ; do i=G%isc, G%iec + J1 = J - G%jsdB + 1 + volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo enddo endif @@ -728,37 +726,28 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_layer) then ! H-points do k=1,nz - vol_sum(k) = 0. - stuff_sum(k) = 0. if (is_extensive) then do j=G%jsc, G%jec ; do i=G%isc, G%iec - if (G%mask2dT(i,j)>0. .and. h(i,j,k)>0.) then - v1 = G%areaT(i,j) - vol_sum(k) = vol_sum(k) + v1 - stuff_sum(k) = stuff_sum(k) + v1 * field(i,j,k) + if (h(i,j,k) > 0.) then + volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + stuff(i,j,k) = volume(i,j,k) * field(i,j,k) + else + volume(i,j,k) = 0. + stuff(i,j,k) = 0. endif enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do i=G%isc, G%iec - if (G%mask2dT(i,j)>0. .and. h(i,j,k)>0.) then - v1 = G%areaT(i,j) * h(i,j,k) - vol_sum(k) = vol_sum(k) + v1 - stuff_sum(k) = stuff_sum(k) + v1 * field(i,j,k) - endif + volume(i,j,k) = G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) + stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo endif enddo else ! Interface do k=1,nz - vol_sum(k) = 0. - stuff_sum(k) = 0. do j=G%jsc, G%jec ; do i=G%isc, G%iec - val = field(i,j,k) - if (G%mask2dT(i,j)>0. .and. val/=missing_value) then - v1 = G%areaT(i,j) - vol_sum(k) = vol_sum(k) + v1 - stuff_sum(k) = stuff_sum(k) + v1 * field(i,j,k) - endif + volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo enddo endif @@ -766,14 +755,18 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, call assert(.false., 'horizontally_average_diag_field: Q point averaging is not coded yet.') endif - call sum_across_PEs(vol_sum, nz) - call sum_across_PEs(stuff_sum, nz) + do k = 1,nz + vol_sum(k) = reproducing_sum(volume(:,:,k)) + stuff_sum(k) = reproducing_sum(stuff(:,:,k)) + enddo + averaged_mask(:) = .true. do k=1,nz - if (vol_sum(k)>0.) then + if (vol_sum(k) > 0.) then averaged_field(k) = stuff_sum(k) / vol_sum(k) else - averaged_field(k) = missing_value + averaged_field(k) = 0. + averaged_mask(k) = .false. endif enddo From 9d8468a324520802ecb5f38c3dc759c55637c0da Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 21 Jun 2019 13:30:02 -0600 Subject: [PATCH 091/106] Commenting salt_flux adjustment in net_FW --- config_src/mct_driver/MOM_surface_forcing.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 3a82794723..67bf2f1913 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -513,9 +513,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & - (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) + !if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & + ! net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & + ! (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) enddo; enddo From 97c2395a58af4f5ad716bb52742fa5d64a07c659 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Sun, 23 Jun 2019 17:42:58 -0600 Subject: [PATCH 092/106] Commenting out salt_flux adjustment in net_FW in NUOPC cap --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index aecfd419da..c90526f98a 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -552,9 +552,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & - (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) + !if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & + ! net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & + ! (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) + net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) enddo ; enddo From fa222631c87bcb22e83b76a3d681c0478c0a96c4 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 25 Jun 2019 11:42:14 -0400 Subject: [PATCH 093/106] (+) Enable checksums for all diagnostics This patch consists of three major changes. 1. We have modified the `DIAG_AS_CHKSUM` feature as a "checksum" mode, where all diagnostics registered via these functions: * `register_diag_field` * `register_static_field` * `register_scalar_field` are caught before they are formally registered with FMS. We make two changes: a. We do not formally register the diagnostic with FMS, and instead assign them dummy FMS ids, used to enable checksums. b. We enable all diagnostics, regardless of the contents of `diag_table` Whenever data is formally written to FMS via `post_data`, we instead calculate the checksum data for the fields via the `MOM_checksum` functions and log the output to the `chksum_diag` file. 2. To more fully support these checksums, we have made several changes to the checksum module. a. We have introduced two new checksum functions, `chksum0` for scalars and `zchksum` for 1-d arrays (typically vertical columns) b. Checksum functions now support an optional IO unit, which defaults to stderr (now formally defined via `iso_fortran_env`). c. `subStats` functions now return their mean, min, and max values, rather than logging the results directly. 3. The `chksum_general` interface and its functions were removed from `MOM_checksums`, and we use the existing gridded checksums (hcksum, etc.) Due to removal of the `chksum_general` functions and addition of IO unit inputs to the other functions, this patch is an API change to MOM. But existing checksum functions should be unaffected. --- src/framework/MOM_checksums.F90 | 794 +++++++++++++++++----------- src/framework/MOM_diag_mediator.F90 | 138 +++-- 2 files changed, 582 insertions(+), 350 deletions(-) diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index df014dc7a5..c6a23667db 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -10,11 +10,13 @@ module MOM_checksums use MOM_file_parser, only : log_version, param_file_type use MOM_hor_index, only : hor_index_type +use iso_fortran_env, only: error_unit + implicit none ; private +public :: chksum0, zchksum public :: hchksum, Bchksum, uchksum, vchksum, qchksum, is_NaN, chksum public :: hchksum_pair, uvchksum, Bchksum_pair -public :: chksum_general public :: MOM_checksums_init !> Checksums a pair of arrays (2d or 3d) staggered at tracer points @@ -72,11 +74,7 @@ module MOM_checksums module procedure is_NaN_0d, is_NaN_1d, is_NaN_2d, is_NaN_3d end interface -!> Return the bitcount of an array -interface chksum_general - module procedure chksum_general_1d, chksum_general_2d, chksum_general_3d -end interface - +integer, parameter :: bc_modulus = 1000000000 !< Modulus of checksum bitcount integer, parameter :: default_shift=0 !< The default array shift logical :: calculateStatistics=.true. !< If true, report min, max and mean. logical :: writeChksums=.true. !< If true, report the bitcount checksum @@ -85,8 +83,120 @@ module MOM_checksums contains +!> Checksum a scalar field (consistent with array checksums) +subroutine chksum0(scalar, mesg, scale, logunit) + real, intent(in) :: scalar !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging + + real :: scaling !< Explicit rescaling factor + integer :: iounit !< Log IO unit + real :: rs !< Rescaled scalar + integer :: bc !< Scalar bitcount + + if (checkForNaNs .and. is_NaN(scalar)) & + call chksum_error(FATAL, 'NaN detected: '//trim(mesg)) + + scaling = 1.0 ; if (present(scale)) scaling = scale + iounit = error_unit; if(present(logunit)) iounit = logunit + + if (calculateStatistics) then + rs = scaling * scalar + if (is_root_pe()) & + call chk_sum_msg(" scalar:", rs, rs, rs, mesg, iounit) + endif + + if (.not. writeChksums) return + + bc = mod(bitcount(abs(scaling * scalar)), bc_modulus) + if (is_root_pe()) & + call chk_sum_msg(" scalar:", bc, mesg, iounit) + +end subroutine chksum0 + + +!> Checksum a 1d array (typically a column). +subroutine zchksum(array, mesg, scale, logunit) + real, dimension(:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging + + real, allocatable, dimension(:) :: rescaled_array + real :: scaling + integer :: iounit !< Log IO unit + integer :: k + real :: aMean, aMin, aMax + integer :: bc0 + + if (checkForNaNs) then + if (is_NaN(array(:))) & + call chksum_error(FATAL, 'NaN detected: '//trim(mesg)) + endif + + scaling = 1.0 ; if (present(scale)) scaling = scale + iounit = error_unit; if(present(logunit)) iounit = logunit + + if (calculateStatistics) then + if (present(scale)) then + allocate(rescaled_array(LBOUND(array,1):UBOUND(array,1))) + rescaled_array(:) = 0.0 + do k=1, size(array, 1) + rescaled_array(k) = scale * array(k) + enddo + + call subStats(rescaled_array, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(array, aMean, aMin, aMax) + endif + + if (is_root_pe()) & + call chk_sum_msg(" column:", aMean, aMin, aMax, mesg, iounit) + endif + + if (.not. writeChksums) return + + bc0 = subchk(array, scaling) + if (is_root_pe()) call chk_sum_msg(" column:", bc0, mesg, iounit) + + contains + + integer function subchk(array, scale) + real, dimension(:), intent(in) :: array !< The array to be checksummed + real, intent(in) :: scale !< A scaling factor for this array. + integer :: k, bc + subchk = 0 + do k=LBOUND(array, 1), UBOUND(array, 1) + bc = bitcount(abs(scale * array(k))) + subchk = subchk + bc + enddo + subchk=mod(subchk, bc_modulus) + end function subchk + + subroutine subStats(array, aMean, aMin, aMax) + real, dimension(:), intent(in) :: array !< The array to be checksummed + real, intent(out) :: aMean, aMin, aMax + + integer :: k, n + + aMin = array(1) + aMax = array(1) + n = 0 + do k=LBOUND(array,1), UBOUND(array,1) + aMin = min(aMin, array(k)) + aMax = max(aMax, array(k)) + n = n + 1 + enddo + aMean = sum(array(:)) / real(n) + end subroutine subStats + +end subroutine zchksum + !> Checksums on a pair of 2d arrays staggered at tracer points. -subroutine chksum_pair_h_2d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, scale) +subroutine chksum_pair_h_2d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, & + scale, logunit) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA !< The first array to be checksummed @@ -94,19 +204,23 @@ subroutine chksum_pair_h_2d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, s integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging if (present(haloshift)) then - call chksum_h_2d(arrayA, 'x '//mesg, HI, haloshift, omit_corners, scale=scale) - call chksum_h_2d(arrayB, 'y '//mesg, HI, haloshift, omit_corners, scale=scale) + call chksum_h_2d(arrayA, 'x '//mesg, HI, haloshift, omit_corners, & + scale=scale, logunit=logunit) + call chksum_h_2d(arrayB, 'y '//mesg, HI, haloshift, omit_corners, & + scale=scale, logunit=logunit) else - call chksum_h_2d(arrayA, 'x '//mesg, HI, scale=scale) - call chksum_h_2d(arrayB, 'y '//mesg, HI, scale=scale) + call chksum_h_2d(arrayA, 'x '//mesg, HI, scale=scale, logunit=logunit) + call chksum_h_2d(arrayB, 'y '//mesg, HI, scale=scale, logunit=logunit) endif end subroutine chksum_pair_h_2d !> Checksums on a pair of 3d arrays staggered at tracer points. -subroutine chksum_pair_h_3d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, scale) +subroutine chksum_pair_h_3d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, & + scale, logunit) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:, :), intent(in) :: arrayA !< The first array to be checksummed @@ -114,29 +228,35 @@ subroutine chksum_pair_h_3d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, s integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging if (present(haloshift)) then - call chksum_h_3d(arrayA, 'x '//mesg, HI, haloshift, omit_corners, scale=scale) - call chksum_h_3d(arrayB, 'y '//mesg, HI, haloshift, omit_corners, scale=scale) + call chksum_h_3d(arrayA, 'x '//mesg, HI, haloshift, omit_corners, & + scale=scale, logunit=logunit) + call chksum_h_3d(arrayB, 'y '//mesg, HI, haloshift, omit_corners, & + scale=scale, logunit=logunit) else - call chksum_h_3d(arrayA, 'x '//mesg, HI, scale=scale) - call chksum_h_3d(arrayB, 'y '//mesg, HI, scale=scale) + call chksum_h_3d(arrayA, 'x '//mesg, HI, scale=scale, logunit=logunit) + call chksum_h_3d(arrayB, 'y '//mesg, HI, scale=scale, logunit=logunit) endif end subroutine chksum_pair_h_3d !> Checksums a 2d array staggered at tracer points. -subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale) +subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j + real :: aMean, aMin, aMax integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners @@ -147,20 +267,27 @@ subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale) ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif + scaling = 1.0 ; if (present(scale)) scaling = scale + iounit = error_unit; if(present(logunit)) iounit = logunit + + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2)) ) + rescaled_array(:,:) = 0.0 + do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec + rescaled_array(i,j) = scale*array(i,j) + enddo ; enddo + call subStats(HI, rescaled_array, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, aMean, aMin, aMax) + endif - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 - do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec - rescaled_array(i,j) = scale*array(i,j) - enddo ; enddo - call subStats(HI, rescaled_array, mesg) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg) - endif ; endif + if (is_root_pe()) & + call chk_sum_msg("h-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -179,7 +306,7 @@ subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale) bc0 = subchk(array, HI, 0, 0, scaling) if (hshift==0) then - if (is_root_pe()) call chk_sum_msg("h-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("h-point:", bc0, mesg, iounit) return endif @@ -191,14 +318,16 @@ subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale) bcNW = subchk(array, HI, -hshift, hshift, scaling) bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("h-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("h-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else bcS = subchk(array, HI, 0, -hshift, scaling) bcE = subchk(array, HI, hshift, 0, scaling) bcW = subchk(array, HI, -hshift, 0, scaling) bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("h-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("h-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -215,16 +344,15 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg) + subroutine subStats(HI, array, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, intent(out) :: aMean, aMin, aMax integer :: i, j, n - real :: aMean, aMin, aMax aMin = array(HI%isc,HI%jsc) aMax = array(HI%isc,HI%jsc) @@ -239,13 +367,13 @@ subroutine subStats(HI, array, mesg) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("h-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_h_2d !> Checksums on a pair of 2d arrays staggered at q-points. -subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, & + omit_corners, scale, logunit) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA !< The first array to be checksummed @@ -255,6 +383,7 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical :: sym @@ -262,18 +391,21 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit if (present(haloshift)) then call chksum_B_2d(arrayA, 'x '//mesg, HI, haloshift, symmetric=sym, & - omit_corners=omit_corners, scale=scale) + omit_corners=omit_corners, scale=scale, logunit=logunit) call chksum_B_2d(arrayB, 'y '//mesg, HI, haloshift, symmetric=sym, & - omit_corners=omit_corners, scale=scale) + omit_corners=omit_corners, scale=scale, logunit=logunit) else - call chksum_B_2d(arrayA, 'x '//mesg, HI, symmetric=sym, scale=scale) - call chksum_B_2d(arrayB, 'y '//mesg, HI, symmetric=sym, scale=scale) + call chksum_B_2d(arrayA, 'x '//mesg, HI, symmetric=sym, scale=scale, & + logunit=logunit) + call chksum_B_2d(arrayB, 'y '//mesg, HI, symmetric=sym, scale=scale, & + logunit=logunit) endif end subroutine chksum_pair_B_2d !> Checksums on a pair of 3d arrays staggered at q-points. -subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, & + omit_corners, scale, logunit) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:, :), intent(in) :: arrayA !< The first array to be checksummed @@ -283,23 +415,27 @@ subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical :: sym if (present(haloshift)) then call chksum_B_3d(arrayA, 'x '//mesg, HI, haloshift, symmetric, & - omit_corners, scale=scale) + omit_corners, scale=scale, logunit=logunit) call chksum_B_3d(arrayB, 'y '//mesg, HI, haloshift, symmetric, & - omit_corners, scale=scale) + omit_corners, scale=scale, logunit=logunit) else - call chksum_B_3d(arrayA, 'x '//mesg, HI, symmetric=symmetric, scale=scale) - call chksum_B_3d(arrayB, 'y '//mesg, HI, symmetric=symmetric, scale=scale) + call chksum_B_3d(arrayA, 'x '//mesg, HI, symmetric=symmetric, scale=scale, & + logunit=logunit) + call chksum_B_3d(arrayB, 'y '//mesg, HI, symmetric=symmetric, scale=scale, & + logunit=logunit) endif end subroutine chksum_pair_B_3d !> Checksums a 2d array staggered at corner points. -subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, & + scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:), & intent(in) :: array !< The array to be checksummed @@ -309,10 +445,13 @@ subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal !! full symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j, Is, Js + real :: aMean, aMin, aMax integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -323,24 +462,30 @@ subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif + scaling = 1.0 ; if (present(scale)) scaling = scale + 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 - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 - Is = HI%isc ; if (sym_stats) Is = HI%isc-1 - Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 - do J=Js,HI%JecB ; do I=Is,HI%IecB - rescaled_array(I,J) = scale*array(I,J) - enddo ; enddo - call subStats(HI, rescaled_array, mesg, sym_stats) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg, sym_stats) - endif ; endif + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2)) ) + rescaled_array(:,:) = 0.0 + Is = HI%isc ; if (sym_stats) Is = HI%isc-1 + Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 + do J=Js,HI%JecB ; do I=Is,HI%IecB + rescaled_array(I,J) = scale*array(I,J) + enddo ; enddo + call subStats(HI, rescaled_array, sym_stats, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, sym_stats, aMean, aMin, aMax) + endif + if (is_root_pe()) & + call chk_sum_msg("B-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -361,7 +506,7 @@ subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal sym = .false. ; if (present(symmetric)) sym = symmetric if ((hshift==0) .and. .not.sym) then - if (is_root_pe()) call chk_sum_msg("B-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("B-point:", bc0, mesg, iounit) return endif @@ -379,14 +524,16 @@ subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal endif bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("B-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("B-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else bcS = subchk(array, HI, 0, -hshift, scaling) bcE = subchk(array, HI, hshift, 0, scaling) bcW = subchk(array, HI, -hshift, 0, scaling) bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("B-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("B-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -405,18 +552,17 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg, sym_stats) + subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. + real, intent(out) :: aMean, aMin, aMax integer :: i, j, n, IsB, JsB - real :: aMean, aMin, aMax IsB = HI%isc ; if (sym_stats) IsB = HI%isc-1 JsB = HI%jsc ; if (sym_stats) JsB = HI%jsc-1 @@ -433,13 +579,13 @@ subroutine subStats(HI, array, mesg, sym_stats) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("B-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_B_2d !> Checksums a pair of 2d velocity arrays staggered at C-grid locations -subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, & + omit_corners, scale, logunit) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: arrayU !< The u-component array to be checksummed @@ -449,19 +595,25 @@ subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging if (present(haloshift)) then - call chksum_u_2d(arrayU, 'u '//mesg, HI, haloshift, symmetric, omit_corners, scale) - call chksum_v_2d(arrayV, 'v '//mesg, HI, haloshift, symmetric, omit_corners, scale) + call chksum_u_2d(arrayU, 'u '//mesg, HI, haloshift, symmetric, & + omit_corners, scale, logunit=logunit) + call chksum_v_2d(arrayV, 'v '//mesg, HI, haloshift, symmetric, & + omit_corners, scale, logunit=logunit) else - call chksum_u_2d(arrayU, 'u '//mesg, HI, symmetric=symmetric) - call chksum_v_2d(arrayV, 'v '//mesg, HI, symmetric=symmetric) + call chksum_u_2d(arrayU, 'u '//mesg, HI, symmetric=symmetric, & + logunit=logunit) + call chksum_v_2d(arrayV, 'v '//mesg, HI, symmetric=symmetric, & + logunit=logunit) endif end subroutine chksum_uv_2d !> Checksums a pair of 3d velocity arrays staggered at C-grid locations -subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, & + omit_corners, scale, logunit) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: arrayU !< The u-component array to be checksummed @@ -471,19 +623,25 @@ subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging if (present(haloshift)) then - call chksum_u_3d(arrayU, 'u '//mesg, HI, haloshift, symmetric, omit_corners, scale) - call chksum_v_3d(arrayV, 'v '//mesg, HI, haloshift, symmetric, omit_corners, scale) + call chksum_u_3d(arrayU, 'u '//mesg, HI, haloshift, symmetric, & + omit_corners, scale, logunit=logunit) + call chksum_v_3d(arrayV, 'v '//mesg, HI, haloshift, symmetric, & + omit_corners, scale, logunit=logunit) else - call chksum_u_3d(arrayU, 'u '//mesg, HI, symmetric=symmetric) - call chksum_v_3d(arrayV, 'v '//mesg, HI, symmetric=symmetric) + call chksum_u_3d(arrayU, 'u '//mesg, HI, symmetric=symmetric, & + logunit=logunit) + call chksum_v_3d(arrayV, 'v '//mesg, HI, symmetric=symmetric, & + logunit=logunit) endif end subroutine chksum_uv_3d !> Checksums a 2d array staggered at C-grid u points. -subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, & + scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message @@ -492,10 +650,13 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j, Is + real :: aMean, aMin, aMax integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -506,24 +667,30 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif - scaling = 1.0 ; if (present(scale)) scaling = scale + scaling = 1.0 ; if (present(scale)) scaling = scale + 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 - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 - Is = HI%isc ; if (sym_stats) Is = HI%isc-1 - do j=HI%jsc,HI%jec ; do I=Is,HI%IecB - rescaled_array(I,j) = scale*array(I,j) - enddo ; enddo - call subStats(HI, rescaled_array, mesg, sym_stats) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg, sym_stats) - endif ; endif + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2)) ) + rescaled_array(:,:) = 0.0 + Is = HI%isc ; if (sym_stats) Is = HI%isc-1 + do j=HI%jsc,HI%jec ; do I=Is,HI%IecB + rescaled_array(I,j) = scale*array(I,j) + enddo ; enddo + call subStats(HI, rescaled_array, sym_stats, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, sym_stats, aMean, aMin, aMax) + endif + + if (is_root_pe()) & + call chk_sum_msg("u-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -544,7 +711,7 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal sym = .false. ; if (present(symmetric)) sym = symmetric if ((hshift==0) .and. .not.sym) then - if (is_root_pe()) call chk_sum_msg("u-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("u-point:", bc0, mesg, iounit) return endif @@ -552,7 +719,7 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal if (hshift==0) then bcW = subchk(array, HI, -hshift-1, 0, scaling) - if (is_root_pe()) call chk_sum_msg_W("u-point:",bc0,bcW,mesg) + if (is_root_pe()) call chk_sum_msg_W("u-point:", bc0, bcW, mesg, iounit) elseif (do_corners) then if (sym) then bcSW = subchk(array, HI, -hshift-1, -hshift, scaling) @@ -564,7 +731,8 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal bcSE = subchk(array, HI, hshift, -hshift, scaling) bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("u-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("u-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else bcS = subchk(array, HI, 0, -hshift, scaling) bcE = subchk(array, HI, hshift, 0, scaling) @@ -575,7 +743,8 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal endif bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("u-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("u-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -594,18 +763,17 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg, sym_stats) + subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. + real, intent(out) :: aMean, aMin, aMax integer :: i, j, n, IsB - real :: aMean, aMin, aMax IsB = HI%isc ; if (sym_stats) IsB = HI%isc-1 @@ -621,13 +789,13 @@ subroutine subStats(HI, array, mesg, sym_stats) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("u-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_u_2d !> Checksums a 2d array staggered at C-grid v points. -subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, & + scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message @@ -636,10 +804,13 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j, Js + real :: aMean, aMin, aMax integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -650,24 +821,30 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif - scaling = 1.0 ; if (present(scale)) scaling = scale + scaling = 1.0 ; if (present(scale)) scaling = scale + 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 - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 - Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 - do J=Js,HI%JecB ; do i=HI%isc,HI%iec - rescaled_array(i,J) = scale*array(i,J) - enddo ; enddo - call subStats(HI, rescaled_array, mesg, sym_stats) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg, sym_stats) - endif ; endif + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2)) ) + rescaled_array(:,:) = 0.0 + Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 + do J=Js,HI%JecB ; do i=HI%isc,HI%iec + rescaled_array(i,J) = scale*array(i,J) + enddo ; enddo + call subStats(HI, rescaled_array, sym_stats, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, sym_stats, aMean, aMin, aMax) + endif + + if (is_root_pe()) & + call chk_sum_msg("v-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -688,7 +865,7 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal sym = .false. ; if (present(symmetric)) sym = symmetric if ((hshift==0) .and. .not.sym) then - if (is_root_pe()) call chk_sum_msg("v-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("v-point:", bc0, mesg, iounit) return endif @@ -696,7 +873,7 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal if (hshift==0) then bcS = subchk(array, HI, 0, -hshift-1, scaling) - if (is_root_pe()) call chk_sum_msg_S("v-point:",bc0,bcS,mesg) + if (is_root_pe()) call chk_sum_msg_S("v-point:", bc0, bcS, mesg, iounit) elseif (do_corners) then if (sym) then bcSW = subchk(array, HI, -hshift, -hshift-1, scaling) @@ -708,7 +885,8 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal bcNW = subchk(array, HI, -hshift, hshift, scaling) bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("v-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("v-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else if (sym) then bcS = subchk(array, HI, 0, -hshift-1, scaling) @@ -719,7 +897,8 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal bcW = subchk(array, HI, -hshift, 0, scaling) bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("v-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("v-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -738,18 +917,17 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg, sym_stats) + subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. + real, intent(out) :: aMean, aMin, aMax integer :: i, j, n, JsB - real :: aMean, aMin, aMax JsB = HI%jsc ; if (sym_stats) JsB = HI%jsc-1 @@ -765,23 +943,25 @@ subroutine subStats(HI, array, mesg, sym_stats) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("v-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_v_2d !> Checksums a 3d array staggered at tracer points. -subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale) +subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j, k + real :: aMean, aMin, aMax integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners @@ -792,22 +972,29 @@ subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale) ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif - scaling = 1.0 ; if (present(scale)) scaling = scale - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 - do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec - rescaled_array(i,j,k) = scale*array(i,j,k) - enddo ; enddo ; enddo + scaling = 1.0 ; if (present(scale)) scaling = scale + iounit = error_unit; if(present(logunit)) iounit = logunit + + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2), & + LBOUND(array,3):UBOUND(array,3)) ) + rescaled_array(:,:,:) = 0.0 + do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec + rescaled_array(i,j,k) = scale*array(i,j,k) + enddo ; enddo ; enddo + + call subStats(HI, rescaled_array, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, aMean, aMin, aMax) + endif - call subStats(HI, rescaled_array, mesg) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg) - endif ; endif + if (is_root_pe()) & + call chk_sum_msg("h-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -826,7 +1013,7 @@ subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale) bc0 = subchk(array, HI, 0, 0, scaling) if (hshift==0) then - if (is_root_pe()) call chk_sum_msg("h-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("h-point:", bc0, mesg, iounit) return endif @@ -838,14 +1025,16 @@ subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale) bcNW = subchk(array, HI, -hshift, hshift, scaling) bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("h-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("h-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else bcS = subchk(array, HI, 0, -hshift, scaling) bcE = subchk(array, HI, hshift, 0, scaling) bcW = subchk(array, HI, -hshift, 0, scaling) bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("h-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("h-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -863,16 +1052,15 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg) + subroutine subStats(HI, array, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, intent(out) :: aMean, aMin, aMax integer :: i, j, k, n - real :: aMean, aMin, aMax aMin = array(HI%isc,HI%jsc,1) aMax = array(HI%isc,HI%jsc,1) @@ -887,13 +1075,13 @@ subroutine subStats(HI, array, mesg) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("h-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_h_3d !> Checksums a 3d array staggered at corner points. -subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, & + scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message @@ -902,10 +1090,13 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j, k, Is, Js + real :: aMean, aMin, aMax integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -916,25 +1107,32 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif + scaling = 1.0 ; if (present(scale)) scaling = scale + 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 - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 - Is = HI%isc ; if (sym_stats) Is = HI%isc-1 - Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 - do k=1,size(array,3) ; do J=Js,HI%JecB ; do I=Is,HI%IecB - rescaled_array(I,J,k) = scale*array(I,J,k) - enddo ; enddo ; enddo - call subStats(HI, rescaled_array, mesg, sym_stats) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg, sym_stats) - endif ; endif + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2), & + LBOUND(array,3):UBOUND(array,3)) ) + rescaled_array(:,:,:) = 0.0 + Is = HI%isc ; if (sym_stats) Is = HI%isc-1 + Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 + do k=1,size(array,3) ; do J=Js,HI%JecB ; do I=Is,HI%IecB + rescaled_array(I,J,k) = scale*array(I,J,k) + enddo ; enddo ; enddo + call subStats(HI, rescaled_array, sym_stats, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, sym_stats, aMean, aMin, aMax) + endif + + if (is_root_pe()) & + call chk_sum_msg("B-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -955,7 +1153,7 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal sym = .false. ; if (present(symmetric)) sym = symmetric if ((hshift==0) .and. .not.sym) then - if (is_root_pe()) call chk_sum_msg("B-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("B-point:", bc0, mesg, iounit) return endif @@ -973,7 +1171,8 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal endif bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("B-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("B-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else if (sym) then bcS = subchk(array, HI, 0, -hshift-1, scaling) @@ -985,7 +1184,8 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal bcE = subchk(array, HI, hshift, 0, scaling) bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("B-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("B-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -1004,18 +1204,17 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg, sym_stats) + subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. + real, intent(out) :: aMean, aMin, aMax integer :: i, j, k, n, IsB, JsB - real :: aMean, aMin, aMax IsB = HI%isc ; if (sym_stats) IsB = HI%isc-1 JsB = HI%jsc ; if (sym_stats) JsB = HI%jsc-1 @@ -1031,13 +1230,13 @@ subroutine subStats(HI, array, mesg, sym_stats) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("B-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_B_3d !> Checksums a 3d array staggered at C-grid u points. -subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, & + scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isdB:,HI%Jsd:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message @@ -1046,10 +1245,13 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j, k, Is + real :: aMean, aMin, aMax integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -1060,24 +1262,30 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif + scaling = 1.0 ; if (present(scale)) scaling = scale + 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 - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 - Is = HI%isc ; if (sym_stats) Is = HI%isc-1 - do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do I=Is,HI%IecB - rescaled_array(I,j,k) = scale*array(I,j,k) - enddo ; enddo ; enddo - call subStats(HI, rescaled_array, mesg, sym_stats) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg, sym_stats) - endif ; endif + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2), & + LBOUND(array,3):UBOUND(array,3)) ) + rescaled_array(:,:,:) = 0.0 + Is = HI%isc ; if (sym_stats) Is = HI%isc-1 + do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do I=Is,HI%IecB + rescaled_array(I,j,k) = scale*array(I,j,k) + enddo ; enddo ; enddo + call subStats(HI, rescaled_array, sym_stats, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, sym_stats, aMean, aMin, aMax) + endif + if (is_root_pe()) & + call chk_sum_msg("u-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -1098,7 +1306,7 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal sym = .false. ; if (present(symmetric)) sym = symmetric if ((hshift==0) .and. .not.sym) then - if (is_root_pe()) call chk_sum_msg("u-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("u-point:", bc0, mesg, iounit) return endif @@ -1106,7 +1314,7 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal if (hshift==0) then bcW = subchk(array, HI, -hshift-1, 0, scaling) - if (is_root_pe()) call chk_sum_msg_W("u-point:",bc0,bcW,mesg) + if (is_root_pe()) call chk_sum_msg_W("u-point:", bc0, bcW, mesg, iounit) elseif (do_corners) then if (sym) then bcSW = subchk(array, HI, -hshift-1, -hshift, scaling) @@ -1118,7 +1326,8 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal bcSE = subchk(array, HI, hshift, -hshift, scaling) bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("u-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("u-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else bcS = subchk(array, HI, 0, -hshift, scaling) bcE = subchk(array, HI, hshift, 0, scaling) @@ -1129,7 +1338,8 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal endif bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("u-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("u-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -1148,18 +1358,17 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg, sym_stats) + subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. + real, intent(out) :: aMean, aMin, aMax integer :: i, j, k, n, IsB - real :: aMean, aMin, aMax IsB = HI%isc ; if (sym_stats) IsB = HI%isc-1 @@ -1175,85 +1384,13 @@ subroutine subStats(HI, array, mesg, sym_stats) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("u-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_u_3d -!> Return the bitcount of an arbitrarily sized 3d array -integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) & - result(subchk) - real, dimension(:,:,:), intent(in) :: array !< Array to be checksummed - real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum - integer, optional, intent(in) :: istart !< Starting index in the i-direction - integer, optional, intent(in) :: iend !< Ending index in the i-direction - integer, optional, intent(in) :: jstart !< Starting index in the j-direction - integer, optional, intent(in) :: jend !< Ending index in the j-direction - integer, optional, intent(in) :: kstart !< Starting index in the k-direction - integer, optional, intent(in) :: kend !< Ending index in the k-direction - integer :: i, j, k, bc, is, ie, js, je, ks, ke - real :: scale - - ! By default do not scale - scale = 1. - if (present(scale_factor)) scale = scale_factor - - ! Set the loop indices based on full array - is = LBOUND(array,1) ; ie = UBOUND(array,1) - js = LBOUND(array,2) ; je = UBOUND(array,2) - ks = LBOUND(array,3) ; ke = UBOUND(array,3) - - ! Override indices if subdomain requested - if (present(istart)) is = istart ; if (present(iend)) ie = iend - if (present(jstart)) js = jstart ; if (present(jend)) je = jend - if (present(kstart)) ks = kstart ; if (present(kend)) ke = kend - - subchk = 0 - do k=ks,ke ; do j=js,je ; do i=is,ie - bc = bitcount(abs(scale*array(i,j,k))) - subchk = subchk + bc - enddo ; enddo ; enddo - call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) -end function chksum_general_3d - -!> Return the bitcount of an arbitrarily sized 2d array by promotion to a 3d array -integer function chksum_general_2d( array_2d, scale_factor, istart, iend, jstart, jend ) - real, dimension(:,:), intent(in) :: array_2d !< Array to be checksummed - real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum - integer, optional, intent(in) :: istart !< Starting index in the i-direction - integer, optional, intent(in) :: iend !< Ending index in the i-direction - integer, optional, intent(in) :: jstart !< Starting index in the j-direction - integer, optional, intent(in) :: jend !< Ending index in the j-direction - integer :: is, ie, js, je - real, dimension(:,:,:), allocatable :: array_3d !< Promotion from 2d to 3d array - - is = LBOUND(array_2d,1) ; ie = UBOUND(array_2d,1) - js = LBOUND(array_2d,2) ; je = UBOUND(array_2d,2) - allocate(array_3d(is:ie, js:je,1)) - array_3d(:,:,1) = array_2d(:,:) - chksum_general_2d = chksum_general_3d( array_3d, scale_factor, istart, iend, jstart, jend ) - deallocate(array_3d) -end function chksum_general_2d - -!> Return the bitcount of an arbitrarily sized 1d array by promotion to a 3d array -integer function chksum_general_1d( array_1d, scale_factor, istart, iend ) - real, dimension(:), intent(in) :: array_1d !< Array to be checksummed - real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum - integer, optional, intent(in) :: istart !< Starting index in the i-direction - integer, optional, intent(in) :: iend !< Ending index in the i-direction - integer :: is, ie - real, dimension(:,:,:), allocatable :: array_3d !< Promotion from 2d to 3d array - - is = LBOUND(array_1d,1) ; ie = UBOUND(array_1d,1) - allocate(array_3d(is:ie, 1,1)) - array_3d(:,1,1) = array_1d(:) - chksum_general_1d = chksum_general_3d( array_3d, scale_factor, istart, iend ) - deallocate(array_3d) -end function chksum_general_1d - !> Checksums a 3d array staggered at C-grid v points. -subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scale) +subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, & + scale, logunit) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message @@ -1262,12 +1399,15 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. + integer, optional, intent(in) :: logunit !< IO unit for checksum logging real, allocatable, dimension(:,:,:) :: rescaled_array real :: scaling + integer :: iounit !< Log IO unit integer :: i, j, k, Js integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW + real :: aMean, aMin, aMax logical :: do_corners, sym, sym_stats if (checkForNaNs) then @@ -1276,24 +1416,30 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal ! if (is_NaN(array)) & ! call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg)) endif + scaling = 1.0 ; if (present(scale)) scaling = scale + 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 - if (calculateStatistics) then ; if (present(scale)) then - allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 - Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 - do k=1,size(array,3) ; do J=Js,HI%JecB ; do i=HI%isc,HI%iec - rescaled_array(i,J,k) = scale*array(i,J,k) - enddo ; enddo ; enddo - call subStats(HI, rescaled_array, mesg, sym_stats) - deallocate(rescaled_array) - else - call subStats(HI, array, mesg, sym_stats) - endif ; endif + if (calculateStatistics) then + if (present(scale)) then + allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & + LBOUND(array,2):UBOUND(array,2), & + LBOUND(array,3):UBOUND(array,3)) ) + rescaled_array(:,:,:) = 0.0 + Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 + do k=1,size(array,3) ; do J=Js,HI%JecB ; do i=HI%isc,HI%iec + rescaled_array(i,J,k) = scale*array(i,J,k) + enddo ; enddo ; enddo + call subStats(HI, rescaled_array, sym_stats, aMean, aMin, aMax) + deallocate(rescaled_array) + else + call subStats(HI, array, sym_stats, aMean, aMin, aMax) + endif + if (is_root_pe()) & + call chk_sum_msg("v-point:", aMean, aMin, aMax, mesg, iounit) + endif if (.not.writeChksums) return @@ -1314,7 +1460,7 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal sym = .false. ; if (present(symmetric)) sym = symmetric if ((hshift==0) .and. .not.sym) then - if (is_root_pe()) call chk_sum_msg("v-point:",bc0,mesg) + if (is_root_pe()) call chk_sum_msg("v-point:", bc0, mesg, iounit) return endif @@ -1322,7 +1468,7 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal if (hshift==0) then bcS = subchk(array, HI, 0, -hshift-1, scaling) - if (is_root_pe()) call chk_sum_msg_S("v-point:",bc0,bcS,mesg) + if (is_root_pe()) call chk_sum_msg_S("v-point:", bc0, bcS, mesg, iounit) elseif (do_corners) then if (sym) then bcSW = subchk(array, HI, -hshift, -hshift-1, scaling) @@ -1334,7 +1480,8 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal bcNW = subchk(array, HI, -hshift, hshift, scaling) bcNE = subchk(array, HI, hshift, hshift, scaling) - if (is_root_pe()) call chk_sum_msg("v-point:",bc0,bcSW,bcSE,bcNW,bcNE,mesg) + if (is_root_pe()) & + call chk_sum_msg("v-point:", bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) else if (sym) then bcS = subchk(array, HI, 0, -hshift-1, scaling) @@ -1345,7 +1492,8 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal bcW = subchk(array, HI, -hshift, 0, scaling) bcN = subchk(array, HI, 0, hshift, scaling) - if (is_root_pe()) call chk_sum_msg_NSEW("v-point:",bc0,bcN,bcS,bcE,bcW,mesg) + if (is_root_pe()) & + call chk_sum_msg_NSEW("v-point:", bc0, bcN, bcS, bcE, bcW, mesg, iounit) endif contains @@ -1364,18 +1512,18 @@ integer function subchk(array, HI, di, dj, scale) subchk = subchk + bc enddo ; enddo ; enddo call sum_across_PEs(subchk) - subchk=mod(subchk,1000000000) + subchk=mod(subchk, bc_modulus) end function subchk - subroutine subStats(HI, array, mesg, sym_stats) + !subroutine subStats(HI, array, mesg, sym_stats) + subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. + real, intent(out) :: aMean, aMin, aMax !< Mean/min/max of array over domain integer :: i, j, k, n, JsB - real :: aMean, aMin, aMax JsB = HI%jsc ; if (sym_stats) JsB = HI%jsc-1 @@ -1391,7 +1539,6 @@ subroutine subStats(HI, array, mesg, sym_stats) call min_across_PEs(aMin) call max_across_PEs(aMax) aMean = aMean / real(n) - if (is_root_pe()) call chk_sum_msg("v-point:",aMean,aMin,aMax,mesg) end subroutine subStats end subroutine chksum_v_3d @@ -1590,15 +1737,18 @@ function is_NaN_3d(x) end function is_NaN_3d !> Write a message including the checksum of the non-shifted array -subroutine chk_sum_msg1(fmsg,bc0,mesg) +subroutine chk_sum_msg1(fmsg, bc0, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller integer, intent(in) :: bc0 !< The bitcount of the non-shifted array - if (is_root_pe()) write(0,'(A,1(A,I10,X),A)') fmsg," c=",bc0,trim(mesg) + integer, intent(in) :: iounit !< Checksum logger IO unit + + if (is_root_pe()) & + write(iounit, '(A,1(A,I10,X),A)') fmsg, " c=", bc0, trim(mesg) end subroutine chk_sum_msg1 !> Write a message including checksums of non-shifted and diagonally shifted arrays -subroutine chk_sum_msg5(fmsg,bc0,bcSW,bcSE,bcNW,bcNE,mesg) +subroutine chk_sum_msg5(fmsg, bc0, bcSW, bcSE, bcNW, bcNE, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller integer, intent(in) :: bc0 !< The bitcount of the non-shifted array @@ -1606,12 +1756,14 @@ subroutine chk_sum_msg5(fmsg,bc0,bcSW,bcSE,bcNW,bcNE,mesg) integer, intent(in) :: bcSE !< The bitcount for SE shifted array integer, intent(in) :: bcNW !< The bitcount for NW shifted array integer, intent(in) :: bcNE !< The bitcount for NE shifted array - if (is_root_pe()) write(0,'(A,5(A,I10,1X),A)') & - fmsg," c=",bc0,"sw=",bcSW,"se=",bcSE,"nw=",bcNW,"ne=",bcNE,trim(mesg) + integer, intent(in) :: iounit !< Checksum logger IO unit + + if (is_root_pe()) write(iounit, '(A,5(A,I10,1X),A)') & + fmsg, " c=", bc0, "sw=", bcSW, "se=", bcSE, "nw=", bcNW, "ne=", bcNE, trim(mesg) end subroutine chk_sum_msg5 !> Write a message including checksums of non-shifted and laterally shifted arrays -subroutine chk_sum_msg_NSEW(fmsg,bc0,bcN,bcS,bcE,bcW,mesg) +subroutine chk_sum_msg_NSEW(fmsg, bc0, bcN, bcS, bcE, bcW, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller integer, intent(in) :: bc0 !< The bitcount of the non-shifted array @@ -1619,49 +1771,59 @@ subroutine chk_sum_msg_NSEW(fmsg,bc0,bcN,bcS,bcE,bcW,mesg) integer, intent(in) :: bcS !< The bitcount for S shifted array integer, intent(in) :: bcE !< The bitcount for E shifted array integer, intent(in) :: bcW !< The bitcount for W shifted array - if (is_root_pe()) write(0,'(A,5(A,I10,1X),A)') & - fmsg," c=",bc0,"N=",bcN,"S=",bcS,"E=",bcE,"W=",bcW,trim(mesg) + integer, intent(in) :: iounit !< Checksum logger IO unit + + if (is_root_pe()) write(iounit, '(A,5(A,I10,1X),A)') & + fmsg, " c=", bc0, "N=", bcN, "S=", bcS, "E=", bcE, "W=", bcW, trim(mesg) end subroutine chk_sum_msg_NSEW !> Write a message including checksums of non-shifted and southward shifted arrays -subroutine chk_sum_msg_S(fmsg,bc0,bcS,mesg) +subroutine chk_sum_msg_S(fmsg, bc0, bcS, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller integer, intent(in) :: bc0 !< The bitcount of the non-shifted array integer, intent(in) :: bcS !< The bitcount of the south-shifted array - if (is_root_pe()) write(0,'(A,2(A,I10,1X),A)') & - fmsg," c=",bc0,"S=",bcS,trim(mesg) + integer, intent(in) :: iounit !< Checksum logger IO unit + + if (is_root_pe()) write(iounit, '(A,2(A,I10,1X),A)') & + fmsg, " c=", bc0, "S=", bcS, trim(mesg) end subroutine chk_sum_msg_S !> Write a message including checksums of non-shifted and westward shifted arrays -subroutine chk_sum_msg_W(fmsg,bc0,bcW,mesg) +subroutine chk_sum_msg_W(fmsg, bc0, bcW, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller integer, intent(in) :: bc0 !< The bitcount of the non-shifted array integer, intent(in) :: bcW !< The bitcount of the west-shifted array - if (is_root_pe()) write(0,'(A,2(A,I10,1X),A)') & - fmsg," c=",bc0,"W=",bcW,trim(mesg) + integer, intent(in) :: iounit !< Checksum logger IO unit + + if (is_root_pe()) write(iounit, '(A,2(A,I10,1X),A)') & + fmsg, " c=", bc0, "W=", bcW, trim(mesg) end subroutine chk_sum_msg_W !> Write a message including checksums of non-shifted and southwestward shifted arrays -subroutine chk_sum_msg2(fmsg,bc0,bcSW,mesg) +subroutine chk_sum_msg2(fmsg, bc0, bcSW, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller integer, intent(in) :: bc0 !< The bitcount of the non-shifted array integer, intent(in) :: bcSW !< The bitcount of the southwest-shifted array - if (is_root_pe()) write(0,'(A,2(A,I9,1X),A)') & - fmsg," c=",bc0,"s/w=",bcSW,trim(mesg) + integer, intent(in) :: iounit !< Checksum logger IO unit + + if (is_root_pe()) write(iounit, '(A,2(A,I9,1X),A)') & + fmsg, " c=", bc0, "s/w=", bcSW, trim(mesg) end subroutine chk_sum_msg2 !> Write a message including the global mean, maximum and minimum of an array -subroutine chk_sum_msg3(fmsg,aMean,aMin,aMax,mesg) +subroutine chk_sum_msg3(fmsg, aMean, aMin, aMax, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller real, intent(in) :: aMean !< The mean value of the array real, intent(in) :: aMin !< The minimum value of the array real, intent(in) :: aMax !< The maximum value of the array - if (is_root_pe()) write(0,'(A,3(A,ES25.16,1X),A)') & - fmsg," mean=",aMean,"min=",aMin,"max=",aMax,trim(mesg) + integer, intent(in) :: iounit !< Checksum logger IO unit + + if (is_root_pe()) write(iounit, '(A,3(A,ES25.16,1X),A)') & + fmsg, " mean=", aMean, "min=", aMin, "max=", aMax, trim(mesg) end subroutine chk_sum_msg3 !> MOM_checksums_init initializes the MOM_checksums module. As it happens, the @@ -1686,7 +1848,7 @@ end subroutine chksum_error !> Does a bitcount of a number by first casting to an integer and then using BTEST !! to check bit by bit -integer function bitcount( x ) +integer function bitcount(x) real :: x !< Number to be bitcount ! Local variables diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 5acc240445..f50ae0e0c3 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -4,7 +4,8 @@ module MOM_diag_mediator ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_checksums, only : chksum_general +use MOM_checksums, only : chksum0, zchksum +use MOM_checksums, only : hchksum, uchksum, vchksum, Bchksum use MOM_coms, only : PE_here use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE @@ -12,6 +13,7 @@ module MOM_diag_mediator use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, vardesc, query_vardesc, mom_read_data +use MOM_io, only : get_filename_appendix use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_string_functions, only : lowercase use MOM_time_manager, only : time_type @@ -237,7 +239,7 @@ module MOM_diag_mediator type, public :: diag_ctrl integer :: available_diag_doc_unit = -1 !< The unit number of a diagnostic documentation file. !! This file is open if available_diag_doc_unit is > 0. - integer :: chksum_diag_doc_unit = -1 !< The unit number of a diagnostic documentation file. + integer :: chksum_iounit = -1 !< The unit number of a diagnostic documentation file. !! This file is open if available_diag_doc_unit is > 0. logical :: diag_as_chksum !< If true, log chksums in a text file instead of posting diagnostics @@ -327,6 +329,9 @@ module MOM_diag_mediator real, dimension(:,:,:), allocatable :: h_old #endif + !> Number of checksum-only diagnostics + integer :: num_chksum_diags + end type diag_ctrl ! CPU clocks @@ -1210,7 +1215,9 @@ subroutine post_data_0d(diag_field_id, field, diag_cs, is_static) 'post_data_0d: Unregistered diagnostic id') diag => diag_cs%diags(diag_field_id) do while (associated(diag)) - if (is_stat) then + if (diag_cs%diag_as_chksum) then + call chksum0(field, diag%debug_str, logunit=diag_cs%chksum_iounit) + else if (is_stat) then used = send_data(diag%fms_diag_id, field) elseif (diag_cs%ave_enabled) then used = send_data(diag%fms_diag_id, field, diag_cs%time_end) @@ -1260,7 +1267,9 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) locfield => field endif - if (is_stat) then + if (diag_cs%diag_as_chksum) then + call zchksum(locfield, diag%debug_str, logunit=diag_cs%chksum_iounit) + else if (is_stat) then used = send_data(diag%fms_diag_id, locfield) elseif (diag_cs%ave_enabled) then used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, weight=diag_cs%time_int) @@ -1397,9 +1406,20 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) endif if (diag_cs%diag_as_chksum) then - chksum = chksum_general(locfield) - if (is_root_pe()) then - call log_chksum_diag(diag_cs%chksum_diag_doc_unit, diag%debug_str, chksum) + if (diag%axes%is_h_point) then + call hchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else if (diag%axes%is_u_point) then + call uchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else if (diag%axes%is_v_point) then + call vchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else if (diag%axes%is_q_point) then + call Bchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else + call MOM_error(FATAL, "post_data_2d_low: unknown axis type.") endif else if (is_stat) then @@ -1672,9 +1692,20 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if (diag%fms_diag_id>0) then if (diag_cs%diag_as_chksum) then - chksum = chksum_general(locfield) - if (is_root_pe()) then - call log_chksum_diag(diag_cs%chksum_diag_doc_unit, diag%debug_str, chksum) + if (diag%axes%is_h_point) then + call hchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else if (diag%axes%is_u_point) then + call uchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else if (diag%axes%is_v_point) then + call vchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else if (diag%axes%is_q_point) then + call Bchksum(locfield, diag%debug_str, diag_cs%G%HI, & + logunit=diag_cs%chksum_iounit) + else + call MOM_error(FATAL, "post_data_3d_low: unknown axis type.") endif else if (is_stat) then @@ -1759,8 +1790,13 @@ subroutine post_xy_average(diag_cs, diag, field) averaged_field, averaged_mask) endif - used = send_data(diag%fms_xyave_diag_id, averaged_field, diag_cs%time_end, & - weight=diag_cs%time_int, mask=averaged_mask) + if (diag_cs%diag_as_chksum) then + call zchksum(averaged_field, trim(diag%debug_str)//'_xyave', & + logunit=diag_CS%chksum_iounit) + else + used = send_data(diag%fms_xyave_diag_id, averaged_field, diag_cs%time_end, & + weight=diag_cs%time_int, mask=averaged_mask) + endif end subroutine post_xy_average !> This subroutine enables the accumulation of time averages over the specified time interval. @@ -1951,6 +1987,9 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time !Register downsampled diagnostics do dl=2,MAX_DSAMP_LEV + ! Do not attempt to checksum the downsampled diagnostics + if (diag_cs%diag_as_chksum) cycle + new_module_name = trim(module_name)//'_d2' if (axes_in%rank == 3 .or. axes_in%rank == 2 ) then @@ -2154,7 +2193,7 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, endif ! For the CMOR variation of the above diagnostic - if (present(cmor_field_name)) then + if (present(cmor_field_name) .and. .not. diag_cs%diag_as_chksum) then ! Fallback values for strings set to "NULL" posted_cmor_units = "not provided" ! posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? @@ -2251,7 +2290,10 @@ integer function register_diag_field_expand_axes(module_name, field_name, axes, volume_id = axes%id_volume ! Get the FMS diagnostic id - if (present(interp_method) .or. axes%is_h_point) then + if (axes%diag_cs%diag_as_chksum) then + fms_id = axes%diag_cs%num_chksum_diags + 1 + axes%diag_cs%num_chksum_diags = fms_id + else if (present(interp_method) .or. axes%is_h_point) then ! If interp_method is provided we must use it if (area_id>0) then if (volume_id>0) then @@ -2563,9 +2605,16 @@ function register_scalar_field(module_name, field_name, init_time, diag_cs, & diag => null() cmor_diag => null() - fms_id = register_diag_field_fms(module_name, field_name, init_time, & - long_name=long_name, units=units, missing_value=MOM_missing_value, & - range=range, standard_name=standard_name, do_not_log=do_not_log, err_msg=err_msg) + if (diag_cs%diag_as_chksum) then + fms_id = diag_cs%num_chksum_diags + 1 + diag_cs%num_chksum_diags = fms_id + else + fms_id = register_diag_field_fms(module_name, field_name, init_time, & + long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, standard_name=standard_name, do_not_log=do_not_log, & + err_msg=err_msg) + endif + if (fms_id /= DIAG_FIELD_NOT_FOUND) then dm_id = get_new_diag_id(diag_cs) call alloc_diag_with_id(dm_id, diag_cs, diag) @@ -2669,11 +2718,17 @@ function register_static_field(module_name, field_name, axes, & diag => null() cmor_diag => null() - fms_id = register_static_field_fms(module_name, field_name, axes%handles, & - long_name=long_name, units=units, missing_value=MOM_missing_value, & - range=range, mask_variant=mask_variant, standard_name=standard_name, & - do_not_log=do_not_log, & - interp_method=interp_method, tile_count=tile_count, area=area) + if (diag_cs%diag_as_chksum) then + fms_id = diag_cs%num_chksum_diags + 1 + diag_cs%num_chksum_diags = fms_id + else + fms_id = register_static_field_fms(module_name, field_name, axes%handles, & + long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, mask_variant=mask_variant, standard_name=standard_name, & + do_not_log=do_not_log, & + interp_method=interp_method, tile_count=tile_count, area=area) + endif + if (fms_id /= DIAG_FIELD_NOT_FOUND) then dm_id = get_new_diag_id(diag_cs) call alloc_diag_with_id(dm_id, diag_cs, diag) @@ -2692,9 +2747,10 @@ function register_static_field(module_name, field_name, axes, & if (present(area_cell_method)) then call diag_field_add_attribute(fms_id, 'cell_methods', 'area:'//trim(area_cell_method)) endif + if (diag_cs%diag_as_chksum) diag%axes => axes endif - if (present(cmor_field_name)) then + if (present(cmor_field_name) .and. .not. diag_cs%diag_as_chksum) then ! Fallback values for strings set to "not provided" posted_cmor_units = "not provided" posted_cmor_standard_name = "not provided" @@ -2905,6 +2961,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_diag_mediator" ! This module's name. + character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs id_clock_diag_mediator = cpu_clock_id('(Ocean diagnostics framework)', grain=CLOCK_MODULE) id_clock_diag_remap = cpu_clock_id('(Ocean diagnostics remapping)', grain=CLOCK_ROUTINE) @@ -2955,6 +3012,9 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) 'a text file containing the checksum (bitcount) of the array.', & default=.false.) + if (diag_cs%diag_as_chksum) & + diag_cs%num_chksum_diags = 0 + ! Keep pointers grid, h, T, S needed diagnostic remapping diag_cs%G => G diag_cs%GV => GV @@ -3023,15 +3083,25 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) endif endif - if (is_root_pe() .and. (diag_CS%chksum_diag_doc_unit < 0) .and. diag_CS%diag_as_chksum) then - write(this_pe,'(i6.6)') PE_here() - doc_file_dflt = "chksum_diag."//this_pe + if (is_root_pe() .and. (diag_CS%chksum_iounit < 0) .and. diag_CS%diag_as_chksum) then + !write(this_pe,'(i6.6)') PE_here() + !doc_file_dflt = "chksum_diag."//this_pe + doc_file_dflt = "chksum_diag" call get_param(param_file, mdl, "CHKSUM_DIAG_FILE", doc_file, & "A file into which to write all checksums of the "//& "diagnostics listed in the diag_table.", & - default=doc_file_dflt, do_not_log=(diag_CS%chksum_diag_doc_unit/=-1)) + default=doc_file_dflt, do_not_log=(diag_CS%chksum_iounit/=-1)) + + call get_filename_appendix(filename_appendix) + if (len_trim(filename_appendix) > 0) then + doc_file = trim(doc_file) //'.'//trim(filename_appendix) + endif +#ifdef STATSLABEL + doc_file = trim(doc_file)//"."//trim(adjustl(STATSLABEL)) +#endif + if (len_trim(doc_file) > 0) then - new_file = .true. ; if (diag_CS%chksum_diag_doc_unit /= -1) new_file = .false. + new_file = .true. ; if (diag_CS%chksum_iounit /= -1) new_file = .false. ! Find an unused unit number. do new_unit=512,42,-1 inquire( new_unit, opened=opened) @@ -3045,16 +3115,16 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) doc_path = trim(slasher(doc_file_dir))//trim(doc_file) endif ; endif - diag_CS%chksum_diag_doc_unit = new_unit + diag_CS%chksum_iounit = new_unit if (new_file) then - open(diag_CS%chksum_diag_doc_unit, file=trim(doc_path), access='SEQUENTIAL', form='FORMATTED', & + open(diag_CS%chksum_iounit, file=trim(doc_path), access='SEQUENTIAL', form='FORMATTED', & action='WRITE', status='REPLACE', iostat=ios) else ! This file is being reopened, and should be appended. - open(diag_CS%chksum_diag_doc_unit, file=trim(doc_path), access='SEQUENTIAL', form='FORMATTED', & + open(diag_CS%chksum_iounit, file=trim(doc_path), access='SEQUENTIAL', form='FORMATTED', & action='WRITE', status='OLD', position='APPEND', iostat=ios) endif - inquire(diag_CS%chksum_diag_doc_unit, opened=opened) + inquire(diag_CS%chksum_iounit, opened=opened) if ((.not.opened) .or. (ios /= 0)) then call MOM_error(FATAL, "Failed to open checksum diags file "//trim(doc_path)//".") endif @@ -3205,8 +3275,8 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) if (diag_CS%available_diag_doc_unit > -1) then close(diag_CS%available_diag_doc_unit) ; diag_CS%available_diag_doc_unit = -3 endif - if (diag_CS%chksum_diag_doc_unit > -1) then - close(diag_CS%chksum_diag_doc_unit) ; diag_CS%chksum_diag_doc_unit = -3 + if (diag_CS%chksum_iounit > -1) then + close(diag_CS%chksum_iounit) ; diag_CS%chksum_iounit = -3 endif deallocate(diag_cs%diags) From e204ea780845ae815d494c6cefd6fbb44be6f4bb Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 26 Jun 2019 10:31:57 -0400 Subject: [PATCH 094/106] Do not attach cell methods in diag chksum mode The diag mediator register functions were using the `attach_cell_method` and `diag_field_add_attribute` functions to attach attributes to the FMS diagnostics. This required referencing of internal FMS field tables, which are not created when DIAG_AS_CHKSUM is enabled. While this did not raise any errors in the Baltic tests (for unclear reasons), this was causing issues in nearly every other test, predominantly when not in debug mode. We now only conditionally call these functions when `diag_as_chksum` is disabled. --- src/framework/MOM_diag_mediator.F90 | 41 ++++++++++++++++++----------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index f50ae0e0c3..9320f503b5 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -2154,9 +2154,10 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & interp_method=interp_method, tile_count=tile_count) - call attach_cell_methods(fms_id, axes, cm_string, & - cell_methods, x_cell_method, y_cell_method, v_cell_method, & - v_extensive=v_extensive) + if (.not. diag_cs%diag_as_chksum) & + call attach_cell_methods(fms_id, axes, cm_string, cell_methods, & + x_cell_method, y_cell_method, v_cell_method, & + v_extensive=v_extensive) if (is_root_pe() .and. diag_CS%available_diag_doc_unit > 0) then msg = '' if (present(cmor_field_name)) msg = 'CMOR equivalent is "'//trim(cmor_field_name)//'"' @@ -2172,8 +2173,9 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & interp_method=interp_method, tile_count=tile_count) - call attach_cell_methods(fms_xyave_id, axes%xyave_axes, cm_string, & - cell_methods, v_cell_method, v_extensive=v_extensive) + if (.not. diag_cs%diag_as_chksum) & + call attach_cell_methods(fms_xyave_id, axes%xyave_axes, cm_string, & + cell_methods, v_cell_method, v_extensive=v_extensive) if (is_root_pe() .and. diag_CS%available_diag_doc_unit > 0) then msg = '' if (present(cmor_field_name)) msg = 'CMOR equivalent is "'//trim(cmor_field_name)//'_xyave"' @@ -2736,18 +2738,25 @@ function register_static_field(module_name, field_name, axes, & diag%fms_diag_id = fms_id diag%debug_str = trim(module_name)//"-"//trim(field_name) if (present(conversion)) diag%conversion_factor = conversion - if (present(x_cell_method)) then - call get_diag_axis_name(axes%handles(1), axis_name) - call diag_field_add_attribute(fms_id, 'cell_methods', trim(axis_name)//':'//trim(x_cell_method)) - endif - if (present(y_cell_method)) then - call get_diag_axis_name(axes%handles(2), axis_name) - call diag_field_add_attribute(fms_id, 'cell_methods', trim(axis_name)//':'//trim(y_cell_method)) - endif - if (present(area_cell_method)) then - call diag_field_add_attribute(fms_id, 'cell_methods', 'area:'//trim(area_cell_method)) + + if (diag_cs%diag_as_chksum) then + diag%axes => axes + else + if (present(x_cell_method)) then + call get_diag_axis_name(axes%handles(1), axis_name) + call diag_field_add_attribute(fms_id, 'cell_methods', & + trim(axis_name)//':'//trim(x_cell_method)) + endif + if (present(y_cell_method)) then + call get_diag_axis_name(axes%handles(2), axis_name) + call diag_field_add_attribute(fms_id, 'cell_methods', & + trim(axis_name)//':'//trim(y_cell_method)) + endif + if (present(area_cell_method)) then + call diag_field_add_attribute(fms_id, 'cell_methods', & + 'area:'//trim(area_cell_method)) + endif endif - if (diag_cs%diag_as_chksum) diag%axes => axes endif if (present(cmor_field_name) .and. .not. diag_cs%diag_as_chksum) then From 058492a14d0b1fd6baa7739920bda28e97530397 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 27 Jun 2019 11:15:54 -0400 Subject: [PATCH 095/106] Repro sum increment_ints_faster overflow check While reproducing_sum was able to detect an overflow for values exceeding its maximum allow value, `prec**N_max * (2**63 - 1)`, this check occurs after the first bin decomposition, which requires an integer conversion, `int(r * (1./prec_max), 8)`. When floating point exceptions (FPE) were disabled, this would often produce a large negative integer, and the overflow would have been caught later and handled as prescribed by the user. But when FPEs are enabled, there is a fatal error and the model aborts. (NOTE: The FPE handler in GCC tags this as "invalid", rather than "overflow") This patch adds a check inside `increment_ints_faster`, so that the `int()` operation is avoided in the case of overflow. --- src/framework/MOM_coms.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 136455dfe6..b80ac56baa 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -40,7 +40,11 @@ module MOM_coms !< An array of the real precision of each of the integers real, parameter, dimension(ni) :: & I_pr = (/ 1.0/r_prec**2, 1.0/r_prec, 1.0, r_prec, r_prec**2, r_prec**3 /) - !< An array of the inverse of thereal precision of each of the integers + !< An array of the inverse of the real precision of each of the integers +real, parameter :: max_efp_float = pr(1) * (2.**63 - 1.) + !< The largest float with an EFP representation. + !! NOTE: Only the first bin can exceed precision, + !! but is bounded by the largest signed integer. logical :: overflow_error = .false. !< This becomes true if an overflow is encountered. logical :: NaN_error = .false. !< This becomes true if a NaN is encountered. @@ -515,6 +519,12 @@ subroutine increment_ints_faster(int_sum, r, max_mag_term) rs = abs(r) if (rs > abs(max_mag_term)) max_mag_term = r + ! Abort if the number has no EFP representation + if (rs > max_efp_float) then + overflow_error = .true. + return + endif + do i=1,ni ival = int(rs*I_pr(i), 8) rs = rs - ival*pr(i) From 1883c1cc9c40b054a6224df58f65a3ef87bca542 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 27 Jun 2019 14:44:40 -0400 Subject: [PATCH 096/106] Flux allocation check in diagnostics Currently the model will attempt to compute any enabled surface flux diagnosics, even if the model has not been configured to support this flux. This would raise memory access errors if the flux had not been allocated. We now conditionally check if a particular surface flux has been allocated before adding it to any cumulative flux diagnostic. In the future, we should probably implement some framework around all this and associate the diagnostic with the creation of the flux. --- src/core/MOM_forcing_type.F90 | 40 +++++++++++++++++++++++++---------- 1 file changed, 29 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 465cdf2c28..165eea239d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2239,10 +2239,14 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_net_massout > 0 .or. handles%id_total_net_massout > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) - if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) - if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) - if (fluxes%seaice_melt(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) + if (associated(fluxes%lprec) .and. fluxes%lprec(i,j) < 0.0) & + res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (associated(fluxes%vprec) .and. fluxes%vprec(i,j) < 0.0) & + res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (associated(fluxes%evap) .and. fluxes%evap(i,j) < 0.0) & + res(i,j) = res(i,j) + fluxes%evap(i,j) + if (associated(fluxes%seaice_melt) .and. fluxes%seaice_melt(i,j) < 0.0) & + res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) 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 @@ -2251,16 +2255,29 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (handles%id_massout_flux > 0) call post_data(handles%id_massout_flux,fluxes%netMassOut,diag) + if (handles%id_massout_flux > 0 .and. associated(fluxes%netMassOut)) & + 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) = fluxes%fprec(i,j) + fluxes%lrunoff(i,j) + fluxes%frunoff(i,j) - if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) - if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + res(i,j) = 0.0 + + 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) .and. fluxes%lprec(i,j) > 0.0) & + res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (associated(fluxes%vprec) .and. fluxes%vprec(i,j) > 0.0) & + res(i,j) = res(i,j) + fluxes%vprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 - if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) - if (fluxes%seaice_melt(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) + if (associated(fluxes%evap) .and. fluxes%evap(i,j) > 0.0) & + res(i,j) = res(i,j) + fluxes%evap(i,j) + if (associated(fluxes%seaice_melt) .and. fluxes%seaice_melt(i,j) > 0.0) & + res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) 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 @@ -2269,7 +2286,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (handles%id_massin_flux > 0) call post_data(handles%id_massin_flux,fluxes%netMassIn,diag) + if (handles%id_massin_flux > 0 .and. associated(fluxes%netMassIn)) & + 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) From 91f3719b4aed47eb044e647a6d19256ceef63382 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 27 Jun 2019 15:11:31 -0400 Subject: [PATCH 097/106] Disable diabatic KE flux for adiabatic runs This patch disables the `KE_dia` diagnostic if the flow has been configured for adiabatic flow. --- src/diagnostics/MOM_diagnostics.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 5da7a91e17..45cfb0ac68 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1439,7 +1439,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag # include "version_variable.h" character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. character(len=48) :: thickness_units, flux_units - logical :: use_temperature + logical :: use_temperature, adiabatic integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nkml, nkbl integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j @@ -1457,6 +1457,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%diag => diag use_temperature = associated(tv%T) + 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) @@ -1642,10 +1644,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'Kinetic Energy Source from Horizontal Viscosity', 'm3 s-3') if (CS%id_KE_horvisc>0) call safe_alloc_ptr(CS%KE_horvisc,isd,ied,jsd,jed,nz) - CS%id_KE_dia = register_diag_field('ocean_model', 'KE_dia', diag%axesTL, Time, & - 'Kinetic Energy Source from Diapycnal Diffusion', 'm3 s-3') - if (CS%id_KE_dia>0) call safe_alloc_ptr(CS%KE_dia,isd,ied,jsd,jed,nz) - + 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') + if (CS%id_KE_dia>0) call safe_alloc_ptr(CS%KE_dia,isd,ied,jsd,jed,nz) + endif ! gravity wave CFLs CS%id_cg1 = register_diag_field('ocean_model', 'cg1', diag%axesT1, Time, & From efe03c1b44e66d70286db06a8ca7dcd85a6263ac Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 27 Jun 2019 16:41:21 -0400 Subject: [PATCH 098/106] Conditional thermodynamic diags; Flux diag bugfix Several thermodynamic diabatic diagnostics in the legacy_diabatic update could be registered and computed when the thermodynamics was disabled, so these are now only conditionally checked and registered when `ENABLE_THERMODYNAMICS` is true. We also fixed a bug in the flux diagnostic registration by splitting the logical association and memory access into two separate stages, since it was raising errors in builds with stricter memory access. --- src/core/MOM_forcing_type.F90 | 42 +++++++++------ .../vertical/MOM_diabatic_driver.F90 | 54 ++++++++++--------- 2 files changed, 54 insertions(+), 42 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 165eea239d..515697c09e 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2239,14 +2239,19 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_net_massout > 0 .or. handles%id_total_net_massout > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%lprec) .and. fluxes%lprec(i,j) < 0.0) & - res(i,j) = res(i,j) + fluxes%lprec(i,j) - if (associated(fluxes%vprec) .and. fluxes%vprec(i,j) < 0.0) & - res(i,j) = res(i,j) + fluxes%vprec(i,j) - if (associated(fluxes%evap) .and. fluxes%evap(i,j) < 0.0) & - res(i,j) = res(i,j) + fluxes%evap(i,j) - if (associated(fluxes%seaice_melt) .and. fluxes%seaice_melt(i,j) < 0.0) & - res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) + if (associated(fluxes%lprec)) then + 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) + fluxes%vprec(i,j) + endif + if (associated(fluxes%evap)) then + 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) + 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 @@ -2269,15 +2274,20 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%frunoff)) & res(i,j) = res(i,j) + fluxes%frunoff(i,j) - if (associated(fluxes%lprec) .and. fluxes%lprec(i,j) > 0.0) & - res(i,j) = res(i,j) + fluxes%lprec(i,j) - if (associated(fluxes%vprec) .and. fluxes%vprec(i,j) > 0.0) & - res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (associated(fluxes%lprec)) then + 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) + fluxes%vprec(i,j) + endif ! fluxes%cond is not needed because it is derived from %evap > 0 - if (associated(fluxes%evap) .and. fluxes%evap(i,j) > 0.0) & - res(i,j) = res(i,j) + fluxes%evap(i,j) - if (associated(fluxes%seaice_melt) .and. fluxes%seaice_melt(i,j) > 0.0) & - res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) + if (associated(fluxes%evap)) then + 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) + 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 diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e21192bfae..25d4eadb7d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2938,32 +2938,34 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di enddo endif - CS%id_Tdif = register_diag_field('ocean_model',"Tflx_dia_diff",diag%axesTi, & - Time, "Diffusive diapycnal temperature flux across interfaces", & - "degC m s-1") - CS%id_Tadv = register_diag_field('ocean_model',"Tflx_dia_adv",diag%axesTi, & - Time, "Advective diapycnal temperature flux across interfaces", & - "degC m s-1") - CS%id_Sdif = register_diag_field('ocean_model',"Sflx_dia_diff",diag%axesTi, & - Time, "Diffusive diapycnal salnity flux across interfaces", & - "psu m s-1") - CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv",diag%axesTi, & - Time, "Advective diapycnal salnity flux across interfaces", & - "psu m s-1") - CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & - 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=US%Z_to_m, & - cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & - cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t') - CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1, Time, & - long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & - standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t', & - units='m2', conversion=US%Z_to_m**2) - CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=US%Z_to_m) - CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & - 'Squared buoyancy frequency below mixed layer', 's-2') - CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & - 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) + if (use_temperature) then + CS%id_Tdif = register_diag_field('ocean_model',"Tflx_dia_diff",diag%axesTi, & + Time, "Diffusive diapycnal temperature flux across interfaces", & + "degC m s-1") + CS%id_Tadv = register_diag_field('ocean_model',"Tflx_dia_adv",diag%axesTi, & + Time, "Advective diapycnal temperature flux across interfaces", & + "degC m s-1") + CS%id_Sdif = register_diag_field('ocean_model',"Sflx_dia_diff",diag%axesTi, & + Time, "Diffusive diapycnal salnity flux across interfaces", & + "psu m s-1") + CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv",diag%axesTi, & + Time, "Advective diapycnal salnity flux across interfaces", & + "psu m s-1") + CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & + 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=US%Z_to_m, & + cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & + cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t') + CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1, Time, & + long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & + standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t', & + units='m2', conversion=US%Z_to_m**2) + CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & + 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=US%Z_to_m) + CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & + 'Squared buoyancy frequency below mixed layer', 's-2') + CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & + 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) + endif call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed "//& "layer depth, MLD_user, following the definition of Levitus 1982. "//& From 771050643a55edbf9415a7f6e2fdea7d741277b7 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 2 Jul 2019 16:11:51 -0400 Subject: [PATCH 099/106] Conditionally enable MEKE Kh diagnostics It is possible to enable the KhMEKE_u and KhMEKE_v diagnostics when their values have not been updated, which will either write nonsense values or raise errors/exceptions if checksums are enabled. This patch introduces a general flag to check if lateral (non-biharmonic) MEKE fluxes have been turned on, and only registers the KhMEKE_[uv] variables if they are present. --- src/parameterizations/lateral/MOM_MEKE.F90 | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 78427dddf8..447f2eefc0 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -66,6 +66,7 @@ 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] + logical :: kh_flux_enabled !< If true, lateral diffusive MEKE flux is enabled. logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. logical :: debug !< If true, write out checksums of data for debugging @@ -383,7 +384,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif ! - if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_advection_factor >0.0) then + if (CS%kh_flux_enabled) then ! Lateral diffusion of MEKE Kh_here = max(0.,CS%MEKE_Kh) !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) @@ -1037,6 +1038,13 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) allocate(CS%del2MEKE(isd:ied,jsd:jed)) ; CS%del2MEKE(:,:) = 0.0 endif + ! Identify if any lateral diffusive processes are active + CS%kh_flux_enabled = .false. + if (CS%MEKE_KH >= 0.0 & + .or. CS%KhMEKE_FAC > 0.0 & + .or. CS%MEKE_advection_factor >0.0) & + CS%kh_flux_enabled = .true. + ! In the case of a restart, these fields need a halo update if (associated(MEKE%MEKE)) then call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) @@ -1079,10 +1087,6 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) 'MEKE energy source', 'm2 s-3') CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & 'MEKE decay rate', 's-1') - CS%id_KhMEKE_u = register_diag_field('ocean_model', 'KHMEKE_u', diag%axesCu1, Time, & - 'Zonal diffusivity of MEKE', 'm2 s-1') - CS%id_KhMEKE_v = register_diag_field('ocean_model', 'KHMEKE_v', diag%axesCv1, Time, & - 'Meridional diffusivity of MEKE', 'm2 s-1') CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & 'MEKE energy available from thickness mixing', 'W m-2') if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 @@ -1100,6 +1104,13 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) CS%id_gamma_t = register_diag_field('ocean_model', 'MEKE_gamma_t', diag%axesT1, Time, & 'Ratio of barotropic eddy velocity to column-mean eddy velocity', 'nondim') + if (CS%kh_flux_enabled) then + CS%id_KhMEKE_u = register_diag_field('ocean_model', 'KHMEKE_u', diag%axesCu1, Time, & + 'Zonal diffusivity of MEKE', 'm2 s-1') + CS%id_KhMEKE_v = register_diag_field('ocean_model', 'KHMEKE_v', diag%axesCv1, Time, & + 'Meridional diffusivity of MEKE', 'm2 s-1') + endif + CS%id_clock_pass = cpu_clock_id('(Ocean continuity halo updates)', grain=CLOCK_ROUTINE) ! Detect whether this instant of MEKE_init() is at the beginning of a run From 2faafaad93ebcedeb9a37af10c42b4669d317b02 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 5 Jul 2019 21:20:30 +0000 Subject: [PATCH 100/106] Fix for static compiles - Arrays CS%Laplac3_const_u, CS%Laplac3_const_v, CS%KH_u_QG, CS%KH_v_QG are declared use the ALLOCABLE_ macro and so must be allocated with the ALLOC_ macro. Otherwise in static mode we are allocating a non-allocatable array. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d2a3d6d1f6..03c2d7b42c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1208,10 +1208,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If true, include the beta term in the Leith nonlinear eddy viscosity.", & default=.true.) - allocate(CS%Laplac3_const_u(IsdB:IedB,jsd:jed)) ; CS%Laplac3_const_u(:,:) = 0.0 - allocate(CS%Laplac3_const_v(isd:ied,JsdB:JedB)) ; CS%Laplac3_const_v(:,:) = 0.0 - allocate(CS%KH_u_QG(IsdB:IedB,jsd:jed,G%ke)) ; CS%KH_u_QG(:,:,:) = 0.0 - allocate(CS%KH_v_QG(isd:ied,JsdB:JedB,G%ke)) ; CS%KH_v_QG(:,:,:) = 0.0 + ALLOC_(CS%Laplac3_const_u(IsdB:IedB,jsd:jed)) ; CS%Laplac3_const_u(:,:) = 0.0 + ALLOC_(CS%Laplac3_const_v(isd:ied,JsdB:JedB)) ; CS%Laplac3_const_v(:,:) = 0.0 + ALLOC_(CS%KH_u_QG(IsdB:IedB,jsd:jed,G%ke)) ; CS%KH_u_QG(:,:,:) = 0.0 + ALLOC_(CS%KH_v_QG(isd:ied,JsdB:JedB,G%ke)) ; CS%KH_v_QG(:,:,:) = 0.0 ! register diagnostics CS%id_KH_u_QG = register_diag_field('ocean_model', 'KH_u_QG', diag%axesCuL, Time, & From 573d3ffc824e9bd58363157f177d54228d7dafc1 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 5 Jul 2019 21:21:37 +0000 Subject: [PATCH 101/106] Correct declaration of h in calc_QG_Leith_viscosity() - The shape of dummy argument h was wrong. This would only change answers in non-symmetric mode so we lucked out! --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 03c2d7b42c..853072f28c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -733,7 +733,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg m-2) integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) From 71693b5d9666c5df333ea1baadc73a87b686b54f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Jul 2019 13:43:24 -0400 Subject: [PATCH 102/106] Split long comments in RGC_tracer.F90 RGC_tracer.F90 previously had some very long comments at the end of some lines. These have now been split onto multiple lines to respect the MOM6 standards for line-length. All answers are bitwise identical. --- src/tracer/RGC_tracer.F90 | 67 ++++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 32 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index b056ae3a76..decb834a6a 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -64,12 +64,14 @@ module RGC_tracer !> This subroutine is used to register tracer fields function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI ! Initializes the NTR tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. +!! and it sets up the tracer output. subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & layer_CSp, sponge_CSp) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - logical, intent(in) :: restart !< .true. if the fields have already been read from a restart file. - type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. - type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call to RGC_register_tracer. - type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure - type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness, in m or kg m-2. + type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. This is not being used for now. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to RGC_register_tracer. + type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure + type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the + !! sponges, if they are in use. Otherwise this may be unassociated. real, allocatable :: temp(:,:,:) real, pointer, dimension(:,:,:) :: & @@ -265,8 +273,8 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & end subroutine initialize_RGC_tracer !> This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. -! This is a simple example of a set of advected passive tracers. +!! tracer physics or chemistry to the tracers from this file. +!! This is a simple example of a set of advected passive tracers. subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -283,20 +291,15 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, 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 any possible forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [s]. - type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. - real, optional,intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be fluxed out of the top layer in a timestep [nondim]. - real, optional,intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes can be applied [m]. - -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible + !! forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call [s]. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be + !! fluxed out of the top layer in a timestep [nondim]. + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes + !! can be applied [m]. + ! 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] From 7a9cf328a0445a169394d1f3a9a561b8a68dcdee Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Jul 2019 13:56:45 -0400 Subject: [PATCH 103/106] Split excessively long lines in 2 files Split excessively long lines and corrected the syntax for unit documentation in MOM_lateral_mixing_coeffs.F90 and MOM_thickness_diffuse.F90. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 71 +++++++++++-------- .../lateral/MOM_thickness_diffuse.F90 | 28 ++++---- 2 files changed, 55 insertions(+), 44 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 853072f28c..3a7d2a01a1 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -180,7 +180,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, 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, use_ebt_mode=.true.) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, & + use_ebt_mode=.true.) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif call pass_var(CS%ebt_struct, G%Domain) @@ -729,43 +730,51 @@ 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, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. -! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) -! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg m-2) - integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) -! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) -! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) -! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) -! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity at q-points (m4 s-1) +! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow [m s-1] +! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence + !! (d/dx(du/dx + dv/dy)) [m-1 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence + !! (d/dy(du/dx + dv/dy)) [m-1 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity + !! (d/dx(dv/dx - du/dy)) [m-1 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity + !! (d/dy(dv/dx - du/dy)) [m-1 s-1] +! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity + !! at h-points [m2 s-1] +! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity + !! at q-points [m2 s-1] +! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity + !! at h-points [m4 s-1] +! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity + !! at q-points [m4 s-1] ! Local variables -! real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) -! dudy, & ! Meridional shear of zonal velocity (s-1) -! dvdx ! Zonal shear of meridional velocity (s-1) +! real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) [s-1] +! dudy, & ! Meridional shear of zonal velocity [s-1] +! dvdx ! Zonal shear of meridional velocity [s-1] real, dimension(SZI_(G),SZJB_(G)) :: & -! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) -! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) - dslopey_dz, & ! z-derivative of y-slope at v-points (m-1) - h_at_v, & ! Thickness at v-points (m or kg m-2) - beta_v, & ! Beta at v-points (m-1 s-1) - grad_vort_mag_v, & ! mag. of vort. grad. at v-points (s-1) - grad_div_mag_v ! mag. of div. grad. at v-points (s-1) +! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] +! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] + dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] + h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] + beta_v, & ! Beta at v-points [m-1 s-1] + grad_vort_mag_v, & ! mag. of vort. grad. at v-points [s-1] + grad_div_mag_v ! mag. of div. grad. at v-points [s-1] real, dimension(SZIB_(G),SZJ_(G)) :: & -! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) -! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) +! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] +! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) - h_at_u, & ! Thickness at u-points (m or kg m-2) - beta_u, & ! Beta at u-points (m-1 s-1) - grad_vort_mag_u, & ! mag. of vort. grad. at u-points (s-1) - grad_div_mag_u ! mag. of div. grad. at u-points (s-1) -! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) + h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] + beta_u, & ! Beta at u-points [m-1 s-1] + grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1] + grad_div_mag_u ! mag. of div. grad. at u-points [s-1] +! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag real :: h_at_slope_above, h_at_slope_below, Ih, f integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index da18462da6..3ebf159e3d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -215,7 +215,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + & + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else @@ -293,8 +294,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js-1,je ; do I=is,ie - Khth_Loc(I,j) = Khth_Loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & - (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) + Khth_Loc(I,j) = Khth_Loc(I,j) + & + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie @@ -525,12 +527,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration of !! density gradients. real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration of !! density gradients. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points @@ -1344,13 +1346,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real, intent(in) :: dt !< Time increment [s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of - !! density gradients. + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of - !! density gradients. + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & de_top ! The distances between the top of a layer and the top of the From 00d99eadc4b540ed57d04b40308f423bd6671f7b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Jul 2019 13:58:30 -0400 Subject: [PATCH 104/106] (*)Multiply fmax by US%s_to_T in MOM_hor_visc.F90 Added a dimensional scaling factor for fmax in MOM_hor_visc.F90 that was dropped at some point in the merging of the dev/ncar code into dev/gfdl. All answers are bitwise identical and now pass the dimensional scaling test. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 919ad02820..efba8e8e8d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -270,7 +270,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [m-1 s-1] grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [m-1 s-1] grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [s-2] - hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. + hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2] + ! This form guarantees that hq/hu < 4. grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [s-2] real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & @@ -1900,8 +1901,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Smagorinsky_Ah) then CS%Biharm_const_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then - fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & - abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) + fmax = US%s_to_T*MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & + abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) CS%Biharm_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif From 85939c3553b23da52a9a8509a7511c8a8125a6ed Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Jul 2019 13:58:58 -0400 Subject: [PATCH 105/106] Travis tests for lines exceeding 120 characters Added the 120 character line limit into the travis testing script. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5c5c31a6a4..1d200d1899 100644 --- a/.travis.yml +++ b/.travis.yml @@ -49,7 +49,7 @@ jobs: - stage: check and compile env: JOB="Code style compliance" script: - - ./.testing/trailer.py -e TEOS10 src config_src + - ./.testing/trailer.py -e TEOS10 -l 120 src config_src - stage: check and compile env: JOB="Doxygen" script: From 3fcd94295d438ce8130af32473a9592ca2b5147e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 9 Jul 2019 18:41:03 -0600 Subject: [PATCH 106/106] Deletes comments --- config_src/mct_driver/MOM_surface_forcing.F90 | 11 ----------- config_src/nuopc_driver/MOM_surface_forcing.F90 | 12 ------------ 2 files changed, 23 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 67bf2f1913..ba0a62677a 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -505,17 +505,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - !if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - ! net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & - ! (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) enddo; enddo diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index c90526f98a..0a11d0147d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -544,18 +544,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - !if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - ! net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & - ! (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) enddo ; enddo